diff options
author | Peter Breitenlohner <peb@mppmu.mpg.de> | 2009-04-21 12:47:39 +0000 |
---|---|---|
committer | Peter Breitenlohner <peb@mppmu.mpg.de> | 2009-04-21 12:47:39 +0000 |
commit | 21b4be81ded3ffd6a9911d002709d718654741a2 (patch) | |
tree | 6be0eef9a7e06696a62fc48571c8ccb3565a1c0d | |
parent | b77e78eaf3652b80e78ae80f770bd3bdf721363d (diff) |
new build system: better texk/web2c/ dependencies, rename mpost->oldmpost and newmpost->mpost
git-svn-id: svn://tug.org/texlive/trunk@12772 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r-- | Build/source/WARNING | 5 | ||||
-rw-r--r-- | Build/source/texk/web2c/Makefile.am | 5 | ||||
-rw-r--r-- | Build/source/texk/web2c/Makefile.in | 753 | ||||
-rw-r--r-- | Build/source/texk/web2c/luatexdir/am/luatex.am | 2 | ||||
-rw-r--r-- | Build/source/texk/web2c/luatexdir/mp/avl.c | 792 | ||||
-rw-r--r-- | Build/source/texk/web2c/luatexdir/mp/avl.h | 118 | ||||
-rw-r--r-- | Build/source/texk/web2c/luatexdir/mp/lmplib.c | 1238 | ||||
-rw-r--r-- | Build/source/texk/web2c/luatexdir/mp/memio.w | 405 | ||||
-rw-r--r-- | Build/source/texk/web2c/luatexdir/mp/mp.w | 26390 | ||||
-rw-r--r-- | Build/source/texk/web2c/luatexdir/mp/psout.w | 5703 | ||||
-rw-r--r-- | Build/source/texk/web2c/luatexdir/mp/tfmin.w | 242 | ||||
-rw-r--r-- | Build/source/texk/web2c/mpdir/am/mp.am | 30 | ||||
-rw-r--r-- | Build/source/texk/web2c/mplibdir/am/libmplib.am | 54 | ||||
-rw-r--r-- | Build/source/texk/web2c/mplibdir/am/mplib.am | 67 |
14 files changed, 517 insertions, 35287 deletions
diff --git a/Build/source/WARNING b/Build/source/WARNING index 8d9b67abe6a..68237e932ec 100644 --- a/Build/source/WARNING +++ b/Build/source/WARNING @@ -7,11 +7,10 @@ At the moment the `Build' script should succeed, but might as well fail. Please inform me of any failures! -The new build system is nearly complete, except for the directories +The new build system is nearly complete, except for the directory - texk/web2c/xetexdir utils/xindy and a few features not yet available. -Peter Breitenlohner 2009-04-08 14:00 UTC +Peter Breitenlohner 2009-04-21 10:00 UTC diff --git a/Build/source/texk/web2c/Makefile.am b/Build/source/texk/web2c/Makefile.am index d3cd2bbaa24..a95cb43876d 100644 --- a/Build/source/texk/web2c/Makefile.am +++ b/Build/source/texk/web2c/Makefile.am @@ -117,9 +117,12 @@ include $(srcdir)/am/texmf.am ## old MetaPost include $(srcdir)/mpdir/am/mp.am -## new MetaPost, also used for by luaTeX +## MetaPost include $(srcdir)/mplibdir/am/mplib.am +## libmplib, used by MetaPost and luaTeX +include $(srcdir)/mplibdir/am/libmplib.am + ## e-TeX include $(srcdir)/etexdir/am/etex.am diff --git a/Build/source/texk/web2c/Makefile.in b/Build/source/texk/web2c/Makefile.in index f702a9ff6d2..3bca8b333e3 100644 --- a/Build/source/texk/web2c/Makefile.in +++ b/Build/source/texk/web2c/Makefile.in @@ -34,7 +34,7 @@ build_triplet = @build@ host_triplet = @host@ @OMFONTS_TRUE@am__append_1 = omegafonts EXTRA_PROGRAMS = $(am__EXEEXT_1) tex$(EXEEXT) mf$(EXEEXT) \ - mf-nowin$(EXEEXT) mpost$(EXEEXT) newmpost$(EXEEXT) \ + mf-nowin$(EXEEXT) oldmpost$(EXEEXT) mpost$(EXEEXT) \ etex$(EXEEXT) pdftex$(EXEEXT) luatex$(EXEEXT) \ luatangle$(EXEEXT) xetex$(EXEEXT) $(am__EXEEXT_4) \ aleph$(EXEEXT) @@ -66,6 +66,7 @@ DIST_COMMON = README $(am__configure_deps) $(dist_check_SCRIPTS) \ $(srcdir)/luatexdir/am/luasocket.am \ $(srcdir)/luatexdir/am/luatangle.am \ $(srcdir)/luatexdir/am/luatex.am $(srcdir)/mpdir/am/mp.am \ + $(srcdir)/mplibdir/am/libmplib.am \ $(srcdir)/mplibdir/am/mplib.am \ $(srcdir)/omegaware/am/omegaware.am \ $(srcdir)/pdftexdir/am/libpdftex.am \ @@ -84,7 +85,7 @@ DIST_COMMON = README $(am__configure_deps) $(dist_check_SCRIPTS) \ @TEX_TRUE@am__append_3 = tex @MF_TRUE@am__append_4 = mf @MFN_TRUE@@MF_TRUE@am__append_5 = mf-nowin -@MP_TRUE@am__append_6 = mpost newmpost +@MP_TRUE@am__append_6 = oldmpost mpost @ETEX_TRUE@am__append_7 = etex @PDFTEX_TRUE@am__append_8 = pdftex @MINGW32_TRUE@am__append_9 = \ @@ -149,6 +150,10 @@ DIST_COMMON = README $(am__configure_deps) $(dist_check_SCRIPTS) \ @PDFTEX_SYNCTEX_TRUE@am__append_36 = \ @PDFTEX_SYNCTEX_TRUE@ synctex-pdf.c +@XETEX_SYNCTEX_TRUE@am__append_37 = -I$(srcdir)/synctexdir +@XETEX_SYNCTEX_TRUE@am__append_38 = \ +@XETEX_SYNCTEX_TRUE@ synctex-xe.c + subdir = . ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/../../m4/kpse-asm.m4 \ @@ -316,22 +321,25 @@ nodist_libmf_a_OBJECTS = $(am__objects_1) libmf_a-mf-pool.$(OBJEXT) libmf_a_OBJECTS = $(nodist_libmf_a_OBJECTS) libmplib_a_AR = $(AR) $(ARFLAGS) libmplib_a_LIBADD = -am__objects_2 = libmplib_a-avl.$(OBJEXT) -am_libmplib_a_OBJECTS = $(am__objects_2) -am__objects_3 = libmplib_a-mp.$(OBJEXT) libmplib_a-psout.$(OBJEXT) \ - libmplib_a-svgout.$(OBJEXT) libmplib_a-memio.$(OBJEXT) \ - libmplib_a-tfmin.$(OBJEXT) -nodist_libmplib_a_OBJECTS = $(am__objects_3) +am_libmplib_a_OBJECTS = libmplib_a-avl.$(OBJEXT) +am__objects_2 = libmplib_a-mp.$(OBJEXT) +am__objects_3 = libmplib_a-psout.$(OBJEXT) +am__objects_4 = libmplib_a-svgout.$(OBJEXT) +nodist_libmplib_a_OBJECTS = libmplib_a-memio.$(OBJEXT) \ + libmplib_a-tfmin.$(OBJEXT) $(am__objects_2) $(am__objects_3) \ + $(am__objects_4) libmplib_a_OBJECTS = $(am_libmplib_a_OBJECTS) \ $(nodist_libmplib_a_OBJECTS) -libmpost_a_AR = $(AR) $(ARFLAGS) -libmpost_a_LIBADD = -am_libmpost_a_OBJECTS = libmpost_a-avl.$(OBJEXT) \ - libmpost_a-avlstuff.$(OBJEXT) libmpost_a-mapfile.$(OBJEXT) \ - libmpost_a-turningnumber.$(OBJEXT) libmpost_a-utils.$(OBJEXT) \ - libmpost_a-writeenc.$(OBJEXT) libmpost_a-writefont.$(OBJEXT) \ - libmpost_a-writet1.$(OBJEXT) -libmpost_a_OBJECTS = $(am_libmpost_a_OBJECTS) +liboldmpost_a_AR = $(AR) $(ARFLAGS) +liboldmpost_a_LIBADD = +am_liboldmpost_a_OBJECTS = liboldmpost_a-avl.$(OBJEXT) \ + liboldmpost_a-avlstuff.$(OBJEXT) \ + liboldmpost_a-mapfile.$(OBJEXT) \ + liboldmpost_a-turningnumber.$(OBJEXT) \ + liboldmpost_a-utils.$(OBJEXT) liboldmpost_a-writeenc.$(OBJEXT) \ + liboldmpost_a-writefont.$(OBJEXT) \ + liboldmpost_a-writet1.$(OBJEXT) +liboldmpost_a_OBJECTS = $(am_liboldmpost_a_OBJECTS) libpdftex_a_AR = $(AR) $(ARFLAGS) libpdftex_a_LIBADD = am__libpdftex_a_SOURCES_DIST = pdftexdir/avl.c pdftexdir/avl.h \ @@ -346,7 +354,7 @@ am__libpdftex_a_SOURCES_DIST = pdftexdir/avl.c pdftexdir/avl.h \ pdftexdir/writepng.c pdftexdir/writet1.c pdftexdir/writet3.c \ pdftexdir/writettf.c pdftexdir/writettf.h pdftexdir/writezip.c \ pdftexdir/regex/regex.c pdftexdir/regex/regex.h -@MINGW32_TRUE@am__objects_4 = libpdftex_a-regex.$(OBJEXT) +@MINGW32_TRUE@am__objects_5 = libpdftex_a-regex.$(OBJEXT) am_libpdftex_a_OBJECTS = libpdftex_a-avl.$(OBJEXT) \ libpdftex_a-avlstuff.$(OBJEXT) libpdftex_a-epdf.$(OBJEXT) \ libpdftex_a-mapfile.$(OBJEXT) libpdftex_a-pdftoepdf.$(OBJEXT) \ @@ -358,7 +366,7 @@ am_libpdftex_a_OBJECTS = libpdftex_a-avl.$(OBJEXT) \ libpdftex_a-writejpg.$(OBJEXT) libpdftex_a-writepng.$(OBJEXT) \ libpdftex_a-writet1.$(OBJEXT) libpdftex_a-writet3.$(OBJEXT) \ libpdftex_a-writettf.$(OBJEXT) libpdftex_a-writezip.$(OBJEXT) \ - $(am__objects_4) + $(am__objects_5) libpdftex_a_OBJECTS = $(am_libpdftex_a_OBJECTS) libxetex_a_AR = $(AR) $(ARFLAGS) libxetex_a_LIBADD = @@ -383,10 +391,10 @@ am__libxetex_a_SOURCES_DIST = xetexdir/MathTable.h \ xetexdir/numbers.c xetexdir/numbers.h xetexdir/pdfimage.cpp \ xetexdir/pdfimage.h xetexdir/pngimage.c xetexdir/pngimage.h \ xetexdir/XeTeXGrLayout.cpp xetexdir/XeTeXGrLayout.h -@XETEX_MACOSX_TRUE@am__objects_5 = \ +@XETEX_MACOSX_TRUE@am__objects_6 = \ @XETEX_MACOSX_TRUE@ libxetex_a-XeTeXFontInst_Mac.$(OBJEXT) \ @XETEX_MACOSX_TRUE@ libxetex_a-XeTeX_mac.$(OBJEXT) -@XETEX_MACOSX_FALSE@am__objects_6 = \ +@XETEX_MACOSX_FALSE@am__objects_7 = \ @XETEX_MACOSX_FALSE@ libxetex_a-XeTeXFontMgr_FC.$(OBJEXT) \ @XETEX_MACOSX_FALSE@ libxetex_a-XeTeX_pic.$(OBJEXT) \ @XETEX_MACOSX_FALSE@ libxetex_a-bmpimage.$(OBJEXT) \ @@ -395,7 +403,7 @@ am__libxetex_a_SOURCES_DIST = xetexdir/MathTable.h \ @XETEX_MACOSX_FALSE@ libxetex_a-numbers.$(OBJEXT) \ @XETEX_MACOSX_FALSE@ libxetex_a-pdfimage.$(OBJEXT) \ @XETEX_MACOSX_FALSE@ libxetex_a-pngimage.$(OBJEXT) -@XETEX_GRAPHITE_TRUE@am__objects_7 = \ +@XETEX_GRAPHITE_TRUE@am__objects_8 = \ @XETEX_GRAPHITE_TRUE@ libxetex_a-XeTeXGrLayout.$(OBJEXT) am_libxetex_a_OBJECTS = libxetex_a-FontTableCache.$(OBJEXT) \ libxetex_a-XeTeXFontInst.$(OBJEXT) \ @@ -405,8 +413,8 @@ am_libxetex_a_OBJECTS = libxetex_a-FontTableCache.$(OBJEXT) \ libxetex_a-XeTeXOTLayoutEngine.$(OBJEXT) \ libxetex_a-XeTeXOTMath.$(OBJEXT) \ libxetex_a-XeTeX_ext.$(OBJEXT) libxetex_a-cmaps.$(OBJEXT) \ - libxetex_a-trans.$(OBJEXT) $(am__objects_5) $(am__objects_6) \ - $(am__objects_7) + libxetex_a-trans.$(OBJEXT) $(am__objects_6) $(am__objects_7) \ + $(am__objects_8) libxetex_a_OBJECTS = $(am_libxetex_a_OBJECTS) libxetexmm_a_AR = $(AR) $(ARFLAGS) libxetexmm_a_LIBADD = @@ -434,7 +442,7 @@ am__EXEEXT_4 = $(am__EXEEXT_2) $(am__EXEEXT_3) @TEX_TRUE@am__EXEEXT_6 = tex$(EXEEXT) @MF_TRUE@am__EXEEXT_7 = mf$(EXEEXT) @MFN_TRUE@@MF_TRUE@am__EXEEXT_8 = mf-nowin$(EXEEXT) -@MP_TRUE@am__EXEEXT_9 = mpost$(EXEEXT) newmpost$(EXEEXT) +@MP_TRUE@am__EXEEXT_9 = oldmpost$(EXEEXT) mpost$(EXEEXT) @ETEX_TRUE@am__EXEEXT_10 = etex$(EXEEXT) @PDFTEX_TRUE@am__EXEEXT_11 = pdftex$(EXEEXT) @LUATEX_TRUE@am__EXEEXT_12 = luatex$(EXEEXT) luatangle$(EXEEXT) @@ -447,15 +455,15 @@ am__installdirs = "$(DESTDIR)$(bindir)" "$(DESTDIR)$(man1dir)" \ binPROGRAMS_INSTALL = $(INSTALL_PROGRAM) PROGRAMS = $(bin_PROGRAMS) $(noinst_PROGRAMS) am_aleph_OBJECTS = aleph-aleph.$(OBJEXT) aleph-alephbis.$(OBJEXT) -am__objects_8 = aleph-alephini.$(OBJEXT) aleph-aleph0.$(OBJEXT) \ +am__objects_9 = aleph-alephini.$(OBJEXT) aleph-aleph0.$(OBJEXT) \ aleph-aleph1.$(OBJEXT) aleph-aleph2.$(OBJEXT) \ aleph-aleph3.$(OBJEXT) -nodist_aleph_OBJECTS = $(am__objects_8) aleph-aleph-pool.$(OBJEXT) \ +nodist_aleph_OBJECTS = $(am__objects_9) aleph-aleph-pool.$(OBJEXT) \ aleph-alephextra.$(OBJEXT) aleph_OBJECTS = $(am_aleph_OBJECTS) $(nodist_aleph_OBJECTS) am__DEPENDENCIES_1 = am__DEPENDENCIES_2 = $(proglib) $(am__DEPENDENCIES_1) -aleph_DEPENDENCIES = $(am__DEPENDENCIES_2) +aleph_DEPENDENCIES = $(am__DEPENDENCIES_2) $(am__DEPENDENCIES_1) nodist_bibtex_OBJECTS = bibtex.$(OBJEXT) bibtex_OBJECTS = $(nodist_bibtex_OBJECTS) bibtex_LDADD = $(LDADD) @@ -491,14 +499,15 @@ dvitype_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1) am__dist_etex_SOURCES_DIST = synctexdir/synctex.h \ synctexdir/synctex-common.h synctexdir/synctex-etex.h dist_etex_OBJECTS = -am__objects_9 = etex-etexini.$(OBJEXT) etex-etex0.$(OBJEXT) \ +am__objects_10 = etex-etexini.$(OBJEXT) etex-etex0.$(OBJEXT) \ etex-etex1.$(OBJEXT) etex-etex2.$(OBJEXT) -@ETEX_SYNCTEX_TRUE@am__objects_10 = etex-synctex-e.$(OBJEXT) -nodist_etex_OBJECTS = $(am__objects_9) etex-etex-pool.$(OBJEXT) \ - etex-etexextra.$(OBJEXT) $(am__objects_10) +@ETEX_SYNCTEX_TRUE@am__objects_11 = etex-synctex-e.$(OBJEXT) +nodist_etex_OBJECTS = $(am__objects_10) etex-etex-pool.$(OBJEXT) \ + etex-etexextra.$(OBJEXT) $(am__objects_11) etex_OBJECTS = $(dist_etex_OBJECTS) $(nodist_etex_OBJECTS) @ETEX_SYNCTEX_TRUE@am__DEPENDENCIES_3 = $(am__DEPENDENCIES_1) -etex_DEPENDENCIES = $(am__DEPENDENCIES_2) $(am__DEPENDENCIES_3) +etex_DEPENDENCIES = $(am__DEPENDENCIES_2) $(am__DEPENDENCIES_1) \ + $(am__DEPENDENCIES_3) am_gftodvi_OBJECTS = nodist_gftodvi_OBJECTS = gftodvi.$(OBJEXT) gftodvi_OBJECTS = $(am_gftodvi_OBJECTS) $(nodist_gftodvi_OBJECTS) @@ -516,8 +525,8 @@ nodist_luatangle_OBJECTS = luatangle.$(OBJEXT) luatangle_OBJECTS = $(nodist_luatangle_OBJECTS) luatangle_LDADD = $(LDADD) luatangle_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1) -am__objects_11 = luatex-luatexini.$(OBJEXT) luatex-luatex0.$(OBJEXT) -nodist_luatex_OBJECTS = $(am__objects_11) luatex-luatex-pool.$(OBJEXT) \ +am__objects_12 = luatex-luatexini.$(OBJEXT) luatex-luatex0.$(OBJEXT) +nodist_luatex_OBJECTS = $(am__objects_12) luatex-luatex-pool.$(OBJEXT) \ luatex-luatexextra.$(OBJEXT) luatex_OBJECTS = $(nodist_luatex_OBJECTS) am__DEPENDENCIES_4 = libluatex.a libff.a libluamisc.a libzzip.a \ @@ -542,15 +551,9 @@ nodist_mft_OBJECTS = mft.$(OBJEXT) mft_OBJECTS = $(nodist_mft_OBJECTS) mft_LDADD = $(LDADD) mft_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1) -am__objects_12 = mpost-mpini.$(OBJEXT) mpost-mp0.$(OBJEXT) \ - mpost-mp1.$(OBJEXT) mpost-mp2.$(OBJEXT) -nodist_mpost_OBJECTS = $(am__objects_12) mpost-mp-pool.$(OBJEXT) \ - mpost-mpextra.$(OBJEXT) +am__objects_13 = mpost-mpxout.$(OBJEXT) +nodist_mpost_OBJECTS = mpost-mpost.$(OBJEXT) $(am__objects_13) mpost_OBJECTS = $(nodist_mpost_OBJECTS) -mpost_DEPENDENCIES = libmpost.a $(am__DEPENDENCIES_2) -am__objects_13 = newmpost-mpost.$(OBJEXT) newmpost-mpxout.$(OBJEXT) -nodist_newmpost_OBJECTS = $(am__objects_13) -newmpost_OBJECTS = $(nodist_newmpost_OBJECTS) nodist_odvicopy_OBJECTS = odvicopy.$(OBJEXT) odvicopy_OBJECTS = $(nodist_odvicopy_OBJECTS) odvicopy_LDADD = $(LDADD) @@ -563,6 +566,12 @@ nodist_ofm2opl_OBJECTS = ofm2opl.$(OBJEXT) ofm2opl_OBJECTS = $(nodist_ofm2opl_OBJECTS) ofm2opl_LDADD = $(LDADD) ofm2opl_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1) +am__objects_14 = oldmpost-mpini.$(OBJEXT) oldmpost-mp0.$(OBJEXT) \ + oldmpost-mp1.$(OBJEXT) oldmpost-mp2.$(OBJEXT) +nodist_oldmpost_OBJECTS = $(am__objects_14) oldmpost-mp-pool.$(OBJEXT) \ + oldmpost-mpextra.$(OBJEXT) +oldmpost_OBJECTS = $(nodist_oldmpost_OBJECTS) +oldmpost_DEPENDENCIES = liboldmpost.a $(am__DEPENDENCIES_2) nodist_opl2ofm_OBJECTS = opl2ofm.$(OBJEXT) opl2ofm_OBJECTS = $(nodist_opl2ofm_OBJECTS) opl2ofm_LDADD = $(LDADD) @@ -586,12 +595,12 @@ patgen_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1) am__dist_pdftex_SOURCES_DIST = synctexdir/synctex.h \ synctexdir/synctex-common.h synctexdir/synctex-pdftex.h dist_pdftex_OBJECTS = -am__objects_14 = pdftex-pdftexini.$(OBJEXT) pdftex-pdftex0.$(OBJEXT) \ +am__objects_15 = pdftex-pdftexini.$(OBJEXT) pdftex-pdftex0.$(OBJEXT) \ pdftex-pdftex1.$(OBJEXT) pdftex-pdftex2.$(OBJEXT) \ pdftex-pdftex3.$(OBJEXT) -@PDFTEX_SYNCTEX_TRUE@am__objects_15 = pdftex-synctex-pdf.$(OBJEXT) -nodist_pdftex_OBJECTS = $(am__objects_14) pdftex-pdftex-pool.$(OBJEXT) \ - pdftex-pdftexextra.$(OBJEXT) $(am__objects_15) +@PDFTEX_SYNCTEX_TRUE@am__objects_16 = pdftex-synctex-pdf.$(OBJEXT) +nodist_pdftex_OBJECTS = $(am__objects_15) pdftex-pdftex-pool.$(OBJEXT) \ + pdftex-pdftexextra.$(OBJEXT) $(am__objects_16) pdftex_OBJECTS = $(dist_pdftex_OBJECTS) $(nodist_pdftex_OBJECTS) am__DEPENDENCIES_6 = libpdftex.a $(am__DEPENDENCIES_1) \ $(am__DEPENDENCIES_1) $(am__DEPENDENCIES_1) \ @@ -628,14 +637,15 @@ tangleboot_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1) am__dist_tex_SOURCES_DIST = synctexdir/synctex.h \ synctexdir/synctex-common.h synctexdir/synctex-tex.h dist_tex_OBJECTS = -am__objects_16 = tex-texini.$(OBJEXT) tex-tex0.$(OBJEXT) \ +am__objects_17 = tex-texini.$(OBJEXT) tex-tex0.$(OBJEXT) \ tex-tex1.$(OBJEXT) tex-tex2.$(OBJEXT) -@TEX_SYNCTEX_TRUE@am__objects_17 = tex-synctex.$(OBJEXT) -nodist_tex_OBJECTS = $(am__objects_16) tex-tex-pool.$(OBJEXT) \ - tex-texextra.$(OBJEXT) $(am__objects_17) +@TEX_SYNCTEX_TRUE@am__objects_18 = tex-synctex.$(OBJEXT) +nodist_tex_OBJECTS = $(am__objects_17) tex-tex-pool.$(OBJEXT) \ + tex-texextra.$(OBJEXT) $(am__objects_18) tex_OBJECTS = $(dist_tex_OBJECTS) $(nodist_tex_OBJECTS) @TEX_SYNCTEX_TRUE@am__DEPENDENCIES_7 = $(am__DEPENDENCIES_1) -tex_DEPENDENCIES = $(am__DEPENDENCIES_2) $(am__DEPENDENCIES_7) +tex_DEPENDENCIES = $(am__DEPENDENCIES_2) $(am__DEPENDENCIES_1) \ + $(am__DEPENDENCIES_7) nodist_tftopl_OBJECTS = tftopl.$(OBJEXT) tftopl_OBJECTS = $(nodist_tftopl_OBJECTS) tftopl_LDADD = $(LDADD) @@ -660,11 +670,15 @@ nodist_weave_OBJECTS = weave.$(OBJEXT) weave_OBJECTS = $(nodist_weave_OBJECTS) weave_LDADD = $(LDADD) weave_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1) -am__objects_18 = xetex-xetexini.$(OBJEXT) xetex-xetex0.$(OBJEXT) \ +am__dist_xetex_SOURCES_DIST = synctexdir/synctex.h \ + synctexdir/synctex-common.h synctexdir/synctex-xetex.h +dist_xetex_OBJECTS = +am__objects_19 = xetex-xetexini.$(OBJEXT) xetex-xetex0.$(OBJEXT) \ xetex-xetex1.$(OBJEXT) xetex-xetex2.$(OBJEXT) -nodist_xetex_OBJECTS = $(am__objects_18) xetex-xetex_pool.$(OBJEXT) \ - xetex-xetexextra.$(OBJEXT) -xetex_OBJECTS = $(nodist_xetex_OBJECTS) +@XETEX_SYNCTEX_TRUE@am__objects_20 = xetex-synctex-xe.$(OBJEXT) +nodist_xetex_OBJECTS = $(am__objects_19) xetex-xetex_pool.$(OBJEXT) \ + xetex-xetexextra.$(OBJEXT) $(am__objects_20) +xetex_OBJECTS = $(dist_xetex_OBJECTS) $(nodist_xetex_OBJECTS) @XETEX_MACOSX_FALSE@am__DEPENDENCIES_8 = $(am__DEPENDENCIES_1) \ @XETEX_MACOSX_FALSE@ $(am__DEPENDENCIES_1) \ @XETEX_MACOSX_FALSE@ $(am__DEPENDENCIES_1) @@ -701,7 +715,7 @@ SOURCES = $(libff_a_SOURCES) $(liblua51_a_SOURCES) \ $(libluasocket_a_SOURCES) $(libluatex_a_SOURCES) \ $(EXTRA_libluatex_a_SOURCES) $(libmd5_a_SOURCES) \ $(nodist_libmf_a_SOURCES) $(libmplib_a_SOURCES) \ - $(nodist_libmplib_a_SOURCES) $(libmpost_a_SOURCES) \ + $(nodist_libmplib_a_SOURCES) $(liboldmpost_a_SOURCES) \ $(libpdftex_a_SOURCES) $(EXTRA_libpdftex_a_SOURCES) \ $(libxetex_a_SOURCES) $(libxetexmm_a_SOURCES) \ $(libzzip_a_SOURCES) $(aleph_SOURCES) $(nodist_aleph_SOURCES) \ @@ -715,9 +729,9 @@ SOURCES = $(libff_a_SOURCES) $(liblua51_a_SOURCES) \ $(nodist_luatex_SOURCES) $(nodist_EXTRA_luatex_SOURCES) \ $(md5main_SOURCES) $(nodist_mf_SOURCES) \ $(nodist_mf_nowin_SOURCES) $(nodist_mft_SOURCES) \ - $(nodist_mpost_SOURCES) $(nodist_newmpost_SOURCES) \ - $(nodist_odvicopy_SOURCES) $(nodist_odvitype_SOURCES) \ - $(nodist_ofm2opl_SOURCES) $(nodist_opl2ofm_SOURCES) \ + $(nodist_mpost_SOURCES) $(nodist_odvicopy_SOURCES) \ + $(nodist_odvitype_SOURCES) $(nodist_ofm2opl_SOURCES) \ + $(nodist_oldmpost_SOURCES) $(nodist_opl2ofm_SOURCES) \ $(nodist_otangle_SOURCES) $(nodist_ovf2ovp_SOURCES) \ $(nodist_ovp2ovf_SOURCES) $(nodist_patgen_SOURCES) \ $(dist_pdftex_SOURCES) $(nodist_pdftex_SOURCES) \ @@ -730,13 +744,13 @@ SOURCES = $(libff_a_SOURCES) $(liblua51_a_SOURCES) \ $(nodist_tftopl_SOURCES) $(nodist_tie_SOURCES) \ $(ttf2afm_SOURCES) $(EXTRA_ttf2afm_SOURCES) \ $(nodist_vftovp_SOURCES) $(nodist_vptovf_SOURCES) \ - $(nodist_weave_SOURCES) $(nodist_xetex_SOURCES) \ - $(nodist_EXTRA_xetex_SOURCES) + $(nodist_weave_SOURCES) $(dist_xetex_SOURCES) \ + $(nodist_xetex_SOURCES) $(nodist_EXTRA_xetex_SOURCES) DIST_SOURCES = $(libff_a_SOURCES) $(liblua51_a_SOURCES) \ $(libluamisc_a_SOURCES) $(EXTRA_libluamisc_a_SOURCES) \ $(libluasocket_a_SOURCES) $(libluatex_a_SOURCES) \ $(EXTRA_libluatex_a_SOURCES) $(libmd5_a_SOURCES) \ - $(libmplib_a_SOURCES) $(libmpost_a_SOURCES) \ + $(libmplib_a_SOURCES) $(liboldmpost_a_SOURCES) \ $(am__libpdftex_a_SOURCES_DIST) $(EXTRA_libpdftex_a_SOURCES) \ $(am__libxetex_a_SOURCES_DIST) $(libxetexmm_a_SOURCES) \ $(libzzip_a_SOURCES) $(aleph_SOURCES) \ @@ -744,7 +758,7 @@ DIST_SOURCES = $(libff_a_SOURCES) $(liblua51_a_SOURCES) \ $(md5main_SOURCES) $(am__dist_pdftex_SOURCES_DIST) \ $(pdftosrc_SOURCES) $(synctex_SOURCES) \ $(am__dist_tex_SOURCES_DIST) $(ttf2afm_SOURCES) \ - $(EXTRA_ttf2afm_SOURCES) + $(EXTRA_ttf2afm_SOURCES) $(am__dist_xetex_SOURCES_DIST) RECURSIVE_TARGETS = all-recursive check-recursive dvi-recursive \ html-recursive info-recursive install-data-recursive \ install-dvi-recursive install-exec-recursive \ @@ -956,9 +970,9 @@ dist_check_SCRIPTS = tangle.test luatexdir/luatangle.test \ omegaware/otangle.test libmd5/md5.test TESTS = tangle.test tiedir/tie.test $(am__append_11) $(am__append_27) \ libmd5/md5.test -EXTRA_LIBRARIES = libmf.a libmpost.a libmplib.a libpdftex.a liblua51.a \ - libzzip.a libluasocket.a libluamisc.a libff.a libluatex.a \ - libxetex.a libxetexmm.a libmd5.a +EXTRA_LIBRARIES = libmf.a liboldmpost.a libmplib.a libpdftex.a \ + liblua51.a libzzip.a libluasocket.a libluamisc.a libff.a \ + libluatex.a libxetex.a libxetexmm.a libmd5.a EXTRA_DIST = PROJECTS cftests config.h cpascal.h help.h tangle.web \ tangle.ch tangleboot.p cwebdir ctangleboot.c cwebboot.c \ $(web_programs:=.web) $(web_programs:=.ch) ctiedir tiedir \ @@ -967,7 +981,7 @@ EXTRA_DIST = PROJECTS cftests config.h cpascal.h help.h tangle.web \ tmf-pool.h mf.web mf-binpool.ch mf.ch mftalk.h lib/texmfmp.c \ tmf-pool.h mp.web mp.ch lib/texmfmp.c mpdir/mp.defines \ mpdir/mplib.h metapost.mk mpdir/Makefile.in.orig \ - mpdir/mpostlib.mk $(newmpost_web) $(libmplib_web) \ + mpdir/mpostlib.mk $(mpost_web) $(libmplib_web) \ mplibdir/lmplib.c $(etex_web_srcs) $(etex_ch_srcs) \ etexdir/etexextra.in lib/texmfmp.c tmf-pool.h \ etexdir/ChangeLog etexdir/INSTALL etexdir/README \ @@ -1123,8 +1137,8 @@ EXTRA_DIST = PROJECTS cftests config.h cpascal.h help.h tangle.web \ synctexdir/synctex-e-rec.ch0 synctexdir/synctex-e-rec.ch1 \ synctexdir/synctex-pdf-rec.ch2 synctexdir/synctex-xe-mem.ch2 \ synctexdir/synctex-xe-rec.ch2 synctexdir/synctex-xe-rec.ch3 \ - synctexdir/synctex-xetex.h synctexdir/synctex.mk fmtutil.in \ - Makefile.in.orig configure.in.orig + synctexdir/synctex.mk fmtutil.in Makefile.in.orig \ + configure.in.orig DISTCLEANFILES = $(EXTRA_LIBRARIES) tangle.c tangle.h tangle.p \ tangle-web2c stamp-tangle tangleboot.c tangleboot.h ctangle.c \ cweb.c stamp-ctangle cftest.p $(web_programs:=.c) \ @@ -1133,10 +1147,11 @@ DISTCLEANFILES = $(EXTRA_LIBRARIES) tangle.c tangle.h tangle.p \ tie.outm $(nodist_tex_SOURCES) tex-final.ch tex-web2c tex.p \ tex.pool tex-tangle $(nodist_libmf_a_SOURCES) mfextra.c \ mf-final.ch mf-web2c mf.p mf.pool mf-tangle \ - $(nodist_mpost_SOURCES) mp-web2c mp.p mp.pool mp-tangle \ - $(newmpost_c_h) mpost-ctangle $(libmplib_c_h) mplib-ctangle \ - $(nodist_etex_SOURCES) etex.web etex.ch etex-web2c etex.p \ - etex.pool etex-tangle etexdir/etex.version \ + $(nodist_oldmpost_SOURCES) mp-web2c mp.p mp.pool mp-tangle \ + $(nodist_mpost_SOURCES) mpxout-ctangle \ + $(nodist_libmplib_a_SOURCES) mp-ctangle psout-ctangle \ + svgout-ctangle $(nodist_etex_SOURCES) etex.web etex.ch \ + etex-web2c etex.p etex.pool etex-tangle etexdir/etex.version \ $(nodist_pdftex_SOURCES) pdftex.ch pdftex-web2c pdftex.p \ pdftex.pool pdftex-tangle pdftexdir/pdftex.version \ $(nodist_luatex_SOURCES) luatex-web2c luatex.p luatex.pool \ @@ -1194,7 +1209,7 @@ nodist_ctie_SOURCES = ctie.c nodist_cweave_SOURCES = cweave.c cweb.c nodist_tie_SOURCES = tie.c tex_CPPFLAGS = $(am__append_29) -tex_LDADD = $(LDADD) $(socketlibs) $(am__append_30) +tex_LDADD = $(LDADD) $(ipc_socketlibs) $(am__append_30) tex_c_h = texini.c tex0.c tex1.c tex2.c texcoerce.h texd.h nodist_tex_SOURCES = $(tex_c_h) tex-pool.c texextra.c $(am__append_31) tex_ch_srcs = \ @@ -1214,12 +1229,12 @@ mf_x_libs = $(X_LIBS) $(x_tool_libs) $(X_PRE_LIBS) $(x_ext_lib) $(wlibs) $(X_EXT mf_c_h = mfini.c mf0.c mf1.c mfcoerce.h mfd.h nodist_libmf_a_SOURCES = $(mf_c_h) mf-pool.c libmf_a_CPPFLAGS = -DMETA_FONT -mpost_CPPFLAGS = -I$(srcdir)/mpdir -mpost_LDADD = libmpost.a $(LDADD) -mpost_c_h = mpini.c mp0.c mp1.c mp2.c mpcoerce.h mpd.h -nodist_mpost_SOURCES = $(mpost_c_h) mp-pool.c mpextra.c -libmpost_a_CPPFLAGS = -I$(srcdir)/mpdir -libmpost_a_SOURCES = \ +oldmpost_CPPFLAGS = -I$(srcdir)/mpdir +oldmpost_LDADD = liboldmpost.a $(LDADD) +oldmpost_c_h = mpini.c mp0.c mp1.c mp2.c mpcoerce.h mpd.h +nodist_oldmpost_SOURCES = $(oldmpost_c_h) mp-pool.c mpextra.c +liboldmpost_a_CPPFLAGS = -I$(srcdir)/mpdir +liboldmpost_a_SOURCES = \ mpdir/avl.c \ mpdir/avl.h \ mpdir/avlstuff.c \ @@ -1232,22 +1247,24 @@ libmpost_a_SOURCES = \ mpdir/writefont.c \ mpdir/writet1.c -newmpost_c_h = mpost.c mpxout.c mpxout.h -newmpost_web = mplibdir/mpost.w mplibdir/mpxout.w -newmpost_CPPFLAGS = -I$(srcdir)/mplibdir -newmpost_DEPENDENCIES = libmplib.a -newmpost_LDADD = libmplib.a $(KPATHSEA_LIBS) -lm -nodist_newmpost_SOURCES = $(newmpost_c_h) -libmplib_c_h = mp.c mplib.h mpmp.h mppsout.h psout.c mplibps.h \ - mplibsvg.h mpsvgout.h svgout.c memio.c tfmin.c -libmplib_true_c = mplibdir/avl.h mplibdir/avl.c -libmplib_web = $(libmplib_true_c) mplibdir/mp.w mplibdir/psout.w \ - mplibdir/svgout.w mplibdir/memio.w mplibdir/tfmin.w +mp_ctangle = CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) +mpost_CPPFLAGS = -I$(srcdir)/mplibdir +mpost_DEPENDENCIES = libmplib.a +mpost_LDADD = libmplib.a $(KPATHSEA_LIBS) -lm +nodist_mpost_SOURCES = mpost.c $(mpxout_c_h) +mpxout_c_h = mpxout.c mpxout.h +mpost_web = mplibdir/mpost.w mplibdir/mpxout.w libmplib_a_CPPFLAGS = -I$(srcdir)/mplibdir -nodist_libmplib_a_SOURCES = $(libmplib_c_h) -libmplib_a_SOURCES = $(libmplib_true_c) +libmplib_a_SOURCES = mplibdir/avl.h mplibdir/avl.c +nodist_libmplib_a_SOURCES = memio.c tfmin.c $(mp_c_h) $(psout_c_h) \ + $(svgout_c_h) +mp_c_h = mp.c mplib.h mpmp.h +psout_c_h = mppsout.h psout.c mplibps.h +svgout_c_h = mplibsvg.h mpsvgout.h svgout.c +libmplib_web = mplibdir/mp.w mplibdir/psout.w mplibdir/svgout.w \ + mplibdir/memio.w mplibdir/tfmin.w etex_CPPFLAGS = $(am__append_32) -etex_LDADD = $(LDADD) $(socketlibs) $(am__append_33) +etex_LDADD = $(LDADD) $(ipc_socketlibs) $(am__append_33) etex_c_h = etexini.c etex0.c etex1.c etex2.c etexcoerce.h etexd.h nodist_etex_SOURCES = $(etex_c_h) etex-pool.c etexextra.c \ etexdir/etexextra.h $(am__append_34) @@ -1321,7 +1338,8 @@ luatex_ldadd = libluatex.a libff.a libluamisc.a libzzip.a \ $(XPDF_LIBS) $(OBSDCOMPAT_LIBS) libmd5.a libmplib.a luatex_LDADD = $(luatex_ldadd) $(LDADD) $(socketlibs) luatex_DEPENDENCIES = $(proglib) libluatex.a $(LIBPNG_DEPEND) \ - $(ZLIB_DEPEND) $(XPDF_DEPEND) $(OBSDCOMPAT_DEPEND) libmd5.a + $(ZLIB_DEPEND) $(XPDF_DEPEND) $(OBSDCOMPAT_DEPEND) libmd5.a \ + libmplib.a luatex_c_h = luatexini.c luatex0.c luatexcoerce.h luatexd.h nodist_luatex_SOURCES = $(luatex_c_h) luatex-pool.c luatexextra.c luatexdir/luatexextra.h luatex_sources = luatexdir/luatex.web luatexdir/luatex.ch @@ -1714,11 +1732,12 @@ xetex_dependencies = $(proglib) $(ICU_DEPEND) $(TECKIT_DEPEND) \ $(am__append_18) $(am__append_21) $(FREETYPE2_DEPEND) \ $(ZLIB_DEPEND) @XETEX_MACOSX_TRUE@xetex_LDFLAGS = -framework Carbon -framework Cocoa -framework QuickTime -xetex_CPPFLAGS = $(xetex_cppflags) +xetex_CPPFLAGS = $(xetex_cppflags) $(am__append_37) xetex_LDADD = $(xetex_ldadd) $(LDADD) $(ipc_socketlibs) xetex_DEPENDENCIES = $(xetex_dependencies) $(libxetex) xetex_c_h = xetexini.c xetex0.c xetex1.c xetex2.c xetexcoerce.h xetexd.h -nodist_xetex_SOURCES = $(xetex_c_h) xetex_pool.c xetexextra.c xetexdir/xetexextra.h +nodist_xetex_SOURCES = $(xetex_c_h) xetex_pool.c xetexextra.c \ + xetexdir/xetexextra.h $(am__append_38) xetex_web_srcs = \ tex.web \ etexdir/etex.ch \ @@ -1768,7 +1787,7 @@ nodist_ovf2ovp_SOURCES = ovf2ovp.c ovf2ovp.h ovf2ovp_sources = omegaware/ovf2ovp.web omegaware/ovf2ovp.ch nodist_ovp2ovf_SOURCES = ovp2ovf.c ovp2ovf.h ovp2ovf_sources = omegaware/ovp2ovf.web omegaware/ovp2ovf.ch -aleph_LDADD = $(LDADD) $(socketlibs) +aleph_LDADD = $(LDADD) $(ipc_socketlibs) aleph_CPPFLAGS = -I$(srcdir)/alephdir $(AM_CPPFLAGS) aleph_c_h = alephini.c aleph0.c aleph1.c aleph2.c aleph3.c alephcoerce.h alephd.h nodist_aleph_SOURCES = $(aleph_c_h) aleph-pool.c alephextra.c @@ -1877,6 +1896,25 @@ synctex_DEPENDENCIES = $(ZLIB_DEPEND) @PDFTEX_SYNCTEX_FALSE@synctex_convert_pdftex = && echo "warning: SyncTeX for pdfTeX is NOT enabled" @PDFTEX_SYNCTEX_TRUE@synctex_convert_pdftex = && $(SHELL) $(srcdir)/synctexdir/synctex-convert.sh pdftex +@XETEX_SYNCTEX_TRUE@xetex_ch_synctex = \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-mem.ch0 \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-e-mem.ch0 \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-e-mem.ch1 \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-xe-mem.ch2 \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-rec.ch0 \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-e-rec.ch0 \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-xe-rec.ch2 + +@XETEX_SYNCTEX_TRUE@xetex_post_ch_synctex = \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-xe-rec.ch3 + +@XETEX_SYNCTEX_TRUE@dist_xetex_SOURCES = \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex.h \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-common.h \ +@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-xetex.h + +@XETEX_SYNCTEX_FALSE@synctex_convert_xetex = && echo "warning: SyncTeX for e-TeX is NOT enabled" +@XETEX_SYNCTEX_TRUE@synctex_convert_xetex = && $(SHELL) $(srcdir)/synctexdir/synctex-convert.sh xetex libmd5_a_CPPFLAGS = -I$(srcdir)/libmd5 libmd5_a_SOURCES = libmd5/md5.c libmd5/md5.h md5main_CPPFLAGS = -I$(srcdir)/libmd5 @@ -1889,7 +1927,7 @@ all: c-auto.h ff-config.h .SUFFIXES: .c .cc .cpp .cxx .lo .o .obj am--refresh: @: -$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(srcdir)/am/bootstrap.am $(srcdir)/am/web.am $(srcdir)/am/cweb.am $(srcdir)/am/texmf.am $(srcdir)/mpdir/am/mp.am $(srcdir)/mplibdir/am/mplib.am $(srcdir)/etexdir/am/etex.am $(srcdir)/pdftexdir/am/pdftex.am $(srcdir)/pdftexdir/am/libpdftex.am $(srcdir)/pdftexdir/am/ttf2afm.am $(srcdir)/pdftexdir/am/pdftosrc.am $(srcdir)/luatexdir/am/luatex.am $(srcdir)/luatexdir/am/luatangle.am $(srcdir)/luatexdir/am/liblua51.am $(srcdir)/luatexdir/am/libzzip.am $(srcdir)/luatexdir/am/luasocket.am $(srcdir)/luatexdir/am/luamisc.am $(srcdir)/luatexdir/am/luafontforge.am $(srcdir)/luatexdir/am/libluatex.am $(srcdir)/xetexdir/am/xetex.am $(srcdir)/omegaware/am/omegaware.am $(srcdir)/alephdir/am/aleph.am $(srcdir)/synctexdir/am/synctex.am $(srcdir)/libmd5/am/md5.am $(am__configure_deps) +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(srcdir)/am/bootstrap.am $(srcdir)/am/web.am $(srcdir)/am/cweb.am $(srcdir)/am/texmf.am $(srcdir)/mpdir/am/mp.am $(srcdir)/mplibdir/am/mplib.am $(srcdir)/mplibdir/am/libmplib.am $(srcdir)/etexdir/am/etex.am $(srcdir)/pdftexdir/am/pdftex.am $(srcdir)/pdftexdir/am/libpdftex.am $(srcdir)/pdftexdir/am/ttf2afm.am $(srcdir)/pdftexdir/am/pdftosrc.am $(srcdir)/luatexdir/am/luatex.am $(srcdir)/luatexdir/am/luatangle.am $(srcdir)/luatexdir/am/liblua51.am $(srcdir)/luatexdir/am/libzzip.am $(srcdir)/luatexdir/am/luasocket.am $(srcdir)/luatexdir/am/luamisc.am $(srcdir)/luatexdir/am/luafontforge.am $(srcdir)/luatexdir/am/libluatex.am $(srcdir)/xetexdir/am/xetex.am $(srcdir)/omegaware/am/omegaware.am $(srcdir)/alephdir/am/aleph.am $(srcdir)/synctexdir/am/synctex.am $(srcdir)/libmd5/am/md5.am $(am__configure_deps) @for dep in $?; do \ case '$(am__configure_deps)' in \ *$$dep*) \ @@ -1978,10 +2016,10 @@ libmplib.a: $(libmplib_a_OBJECTS) $(libmplib_a_DEPENDENCIES) -rm -f libmplib.a $(libmplib_a_AR) libmplib.a $(libmplib_a_OBJECTS) $(libmplib_a_LIBADD) $(RANLIB) libmplib.a -libmpost.a: $(libmpost_a_OBJECTS) $(libmpost_a_DEPENDENCIES) - -rm -f libmpost.a - $(libmpost_a_AR) libmpost.a $(libmpost_a_OBJECTS) $(libmpost_a_LIBADD) - $(RANLIB) libmpost.a +liboldmpost.a: $(liboldmpost_a_OBJECTS) $(liboldmpost_a_DEPENDENCIES) + -rm -f liboldmpost.a + $(liboldmpost_a_AR) liboldmpost.a $(liboldmpost_a_OBJECTS) $(liboldmpost_a_LIBADD) + $(RANLIB) liboldmpost.a libpdftex.a: $(libpdftex_a_OBJECTS) $(libpdftex_a_DEPENDENCIES) -rm -f libpdftex.a $(libpdftex_a_AR) libpdftex.a $(libpdftex_a_OBJECTS) $(libpdftex_a_LIBADD) @@ -2100,9 +2138,6 @@ mft$(EXEEXT): $(mft_OBJECTS) $(mft_DEPENDENCIES) mpost$(EXEEXT): $(mpost_OBJECTS) $(mpost_DEPENDENCIES) @rm -f mpost$(EXEEXT) $(LINK) $(mpost_OBJECTS) $(mpost_LDADD) $(LIBS) -newmpost$(EXEEXT): $(newmpost_OBJECTS) $(newmpost_DEPENDENCIES) - @rm -f newmpost$(EXEEXT) - $(LINK) $(newmpost_OBJECTS) $(newmpost_LDADD) $(LIBS) odvicopy$(EXEEXT): $(odvicopy_OBJECTS) $(odvicopy_DEPENDENCIES) @rm -f odvicopy$(EXEEXT) $(LINK) $(odvicopy_OBJECTS) $(odvicopy_LDADD) $(LIBS) @@ -2112,6 +2147,9 @@ odvitype$(EXEEXT): $(odvitype_OBJECTS) $(odvitype_DEPENDENCIES) ofm2opl$(EXEEXT): $(ofm2opl_OBJECTS) $(ofm2opl_DEPENDENCIES) @rm -f ofm2opl$(EXEEXT) $(LINK) $(ofm2opl_OBJECTS) $(ofm2opl_LDADD) $(LIBS) +oldmpost$(EXEEXT): $(oldmpost_OBJECTS) $(oldmpost_DEPENDENCIES) + @rm -f oldmpost$(EXEEXT) + $(LINK) $(oldmpost_OBJECTS) $(oldmpost_LDADD) $(LIBS) opl2ofm$(EXEEXT): $(opl2ofm_OBJECTS) $(opl2ofm_DEPENDENCIES) @rm -f opl2ofm$(EXEEXT) $(LINK) $(opl2ofm_OBJECTS) $(opl2ofm_LDADD) $(LIBS) @@ -2413,14 +2451,14 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libmplib_a-psout.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libmplib_a-svgout.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libmplib_a-tfmin.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libmpost_a-avl.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libmpost_a-avlstuff.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libmpost_a-mapfile.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libmpost_a-turningnumber.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libmpost_a-utils.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libmpost_a-writeenc.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libmpost_a-writefont.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libmpost_a-writet1.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/liboldmpost_a-avl.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/liboldmpost_a-avlstuff.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/liboldmpost_a-mapfile.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/liboldmpost_a-turningnumber.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/liboldmpost_a-utils.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/liboldmpost_a-writeenc.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/liboldmpost_a-writefont.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/liboldmpost_a-writet1.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libpdftex_a-avl.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libpdftex_a-avlstuff.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libpdftex_a-epdf.Po@am__quote@ @@ -2489,17 +2527,17 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mf-mfextra.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mf_nowin-mfextra.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mft.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mpost-mp-pool.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mpost-mp0.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mpost-mp1.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mpost-mp2.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mpost-mpextra.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mpost-mpini.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/newmpost-mpost.Po@am__quote@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/newmpost-mpxout.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mpost-mpost.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mpost-mpxout.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/odvicopy.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/odvitype.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ofm2opl.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/oldmpost-mp-pool.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/oldmpost-mp0.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/oldmpost-mp1.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/oldmpost-mp2.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/oldmpost-mpextra.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/oldmpost-mpini.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/opl2ofm.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/otangle.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ovf2ovp.Po@am__quote@ @@ -2539,6 +2577,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/vptovf.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/weave.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/xetex-dummy.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/xetex-synctex-xe.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/xetex-xetex0.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/xetex-xetex1.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/xetex-xetex2.Po@am__quote@ @@ -5269,6 +5308,34 @@ libmplib_a-avl.obj: mplibdir/avl.c @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmplib_a-avl.obj `if test -f 'mplibdir/avl.c'; then $(CYGPATH_W) 'mplibdir/avl.c'; else $(CYGPATH_W) '$(srcdir)/mplibdir/avl.c'; fi` +libmplib_a-memio.o: memio.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmplib_a-memio.o -MD -MP -MF $(DEPDIR)/libmplib_a-memio.Tpo -c -o libmplib_a-memio.o `test -f 'memio.c' || echo '$(srcdir)/'`memio.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmplib_a-memio.Tpo $(DEPDIR)/libmplib_a-memio.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='memio.c' object='libmplib_a-memio.o' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmplib_a-memio.o `test -f 'memio.c' || echo '$(srcdir)/'`memio.c + +libmplib_a-memio.obj: memio.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmplib_a-memio.obj -MD -MP -MF $(DEPDIR)/libmplib_a-memio.Tpo -c -o libmplib_a-memio.obj `if test -f 'memio.c'; then $(CYGPATH_W) 'memio.c'; else $(CYGPATH_W) '$(srcdir)/memio.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmplib_a-memio.Tpo $(DEPDIR)/libmplib_a-memio.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='memio.c' object='libmplib_a-memio.obj' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmplib_a-memio.obj `if test -f 'memio.c'; then $(CYGPATH_W) 'memio.c'; else $(CYGPATH_W) '$(srcdir)/memio.c'; fi` + +libmplib_a-tfmin.o: tfmin.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmplib_a-tfmin.o -MD -MP -MF $(DEPDIR)/libmplib_a-tfmin.Tpo -c -o libmplib_a-tfmin.o `test -f 'tfmin.c' || echo '$(srcdir)/'`tfmin.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmplib_a-tfmin.Tpo $(DEPDIR)/libmplib_a-tfmin.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='tfmin.c' object='libmplib_a-tfmin.o' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmplib_a-tfmin.o `test -f 'tfmin.c' || echo '$(srcdir)/'`tfmin.c + +libmplib_a-tfmin.obj: tfmin.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmplib_a-tfmin.obj -MD -MP -MF $(DEPDIR)/libmplib_a-tfmin.Tpo -c -o libmplib_a-tfmin.obj `if test -f 'tfmin.c'; then $(CYGPATH_W) 'tfmin.c'; else $(CYGPATH_W) '$(srcdir)/tfmin.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmplib_a-tfmin.Tpo $(DEPDIR)/libmplib_a-tfmin.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='tfmin.c' object='libmplib_a-tfmin.obj' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmplib_a-tfmin.obj `if test -f 'tfmin.c'; then $(CYGPATH_W) 'tfmin.c'; else $(CYGPATH_W) '$(srcdir)/tfmin.c'; fi` + libmplib_a-mp.o: mp.c @am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmplib_a-mp.o -MD -MP -MF $(DEPDIR)/libmplib_a-mp.Tpo -c -o libmplib_a-mp.o `test -f 'mp.c' || echo '$(srcdir)/'`mp.c @am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmplib_a-mp.Tpo $(DEPDIR)/libmplib_a-mp.Po @@ -5311,145 +5378,117 @@ libmplib_a-svgout.obj: svgout.c @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmplib_a-svgout.obj `if test -f 'svgout.c'; then $(CYGPATH_W) 'svgout.c'; else $(CYGPATH_W) '$(srcdir)/svgout.c'; fi` -libmplib_a-memio.o: memio.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmplib_a-memio.o -MD -MP -MF $(DEPDIR)/libmplib_a-memio.Tpo -c -o libmplib_a-memio.o `test -f 'memio.c' || echo '$(srcdir)/'`memio.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmplib_a-memio.Tpo $(DEPDIR)/libmplib_a-memio.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='memio.c' object='libmplib_a-memio.o' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-avl.o: mpdir/avl.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-avl.o -MD -MP -MF $(DEPDIR)/liboldmpost_a-avl.Tpo -c -o liboldmpost_a-avl.o `test -f 'mpdir/avl.c' || echo '$(srcdir)/'`mpdir/avl.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-avl.Tpo $(DEPDIR)/liboldmpost_a-avl.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/avl.c' object='liboldmpost_a-avl.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmplib_a-memio.o `test -f 'memio.c' || echo '$(srcdir)/'`memio.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-avl.o `test -f 'mpdir/avl.c' || echo '$(srcdir)/'`mpdir/avl.c -libmplib_a-memio.obj: memio.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmplib_a-memio.obj -MD -MP -MF $(DEPDIR)/libmplib_a-memio.Tpo -c -o libmplib_a-memio.obj `if test -f 'memio.c'; then $(CYGPATH_W) 'memio.c'; else $(CYGPATH_W) '$(srcdir)/memio.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmplib_a-memio.Tpo $(DEPDIR)/libmplib_a-memio.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='memio.c' object='libmplib_a-memio.obj' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-avl.obj: mpdir/avl.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-avl.obj -MD -MP -MF $(DEPDIR)/liboldmpost_a-avl.Tpo -c -o liboldmpost_a-avl.obj `if test -f 'mpdir/avl.c'; then $(CYGPATH_W) 'mpdir/avl.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/avl.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-avl.Tpo $(DEPDIR)/liboldmpost_a-avl.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/avl.c' object='liboldmpost_a-avl.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmplib_a-memio.obj `if test -f 'memio.c'; then $(CYGPATH_W) 'memio.c'; else $(CYGPATH_W) '$(srcdir)/memio.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-avl.obj `if test -f 'mpdir/avl.c'; then $(CYGPATH_W) 'mpdir/avl.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/avl.c'; fi` -libmplib_a-tfmin.o: tfmin.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmplib_a-tfmin.o -MD -MP -MF $(DEPDIR)/libmplib_a-tfmin.Tpo -c -o libmplib_a-tfmin.o `test -f 'tfmin.c' || echo '$(srcdir)/'`tfmin.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmplib_a-tfmin.Tpo $(DEPDIR)/libmplib_a-tfmin.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='tfmin.c' object='libmplib_a-tfmin.o' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-avlstuff.o: mpdir/avlstuff.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-avlstuff.o -MD -MP -MF $(DEPDIR)/liboldmpost_a-avlstuff.Tpo -c -o liboldmpost_a-avlstuff.o `test -f 'mpdir/avlstuff.c' || echo '$(srcdir)/'`mpdir/avlstuff.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-avlstuff.Tpo $(DEPDIR)/liboldmpost_a-avlstuff.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/avlstuff.c' object='liboldmpost_a-avlstuff.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmplib_a-tfmin.o `test -f 'tfmin.c' || echo '$(srcdir)/'`tfmin.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-avlstuff.o `test -f 'mpdir/avlstuff.c' || echo '$(srcdir)/'`mpdir/avlstuff.c -libmplib_a-tfmin.obj: tfmin.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmplib_a-tfmin.obj -MD -MP -MF $(DEPDIR)/libmplib_a-tfmin.Tpo -c -o libmplib_a-tfmin.obj `if test -f 'tfmin.c'; then $(CYGPATH_W) 'tfmin.c'; else $(CYGPATH_W) '$(srcdir)/tfmin.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmplib_a-tfmin.Tpo $(DEPDIR)/libmplib_a-tfmin.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='tfmin.c' object='libmplib_a-tfmin.obj' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmplib_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmplib_a-tfmin.obj `if test -f 'tfmin.c'; then $(CYGPATH_W) 'tfmin.c'; else $(CYGPATH_W) '$(srcdir)/tfmin.c'; fi` - -libmpost_a-avl.o: mpdir/avl.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-avl.o -MD -MP -MF $(DEPDIR)/libmpost_a-avl.Tpo -c -o libmpost_a-avl.o `test -f 'mpdir/avl.c' || echo '$(srcdir)/'`mpdir/avl.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-avl.Tpo $(DEPDIR)/libmpost_a-avl.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/avl.c' object='libmpost_a-avl.o' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-avl.o `test -f 'mpdir/avl.c' || echo '$(srcdir)/'`mpdir/avl.c - -libmpost_a-avl.obj: mpdir/avl.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-avl.obj -MD -MP -MF $(DEPDIR)/libmpost_a-avl.Tpo -c -o libmpost_a-avl.obj `if test -f 'mpdir/avl.c'; then $(CYGPATH_W) 'mpdir/avl.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/avl.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-avl.Tpo $(DEPDIR)/libmpost_a-avl.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/avl.c' object='libmpost_a-avl.obj' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-avlstuff.obj: mpdir/avlstuff.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-avlstuff.obj -MD -MP -MF $(DEPDIR)/liboldmpost_a-avlstuff.Tpo -c -o liboldmpost_a-avlstuff.obj `if test -f 'mpdir/avlstuff.c'; then $(CYGPATH_W) 'mpdir/avlstuff.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/avlstuff.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-avlstuff.Tpo $(DEPDIR)/liboldmpost_a-avlstuff.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/avlstuff.c' object='liboldmpost_a-avlstuff.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-avl.obj `if test -f 'mpdir/avl.c'; then $(CYGPATH_W) 'mpdir/avl.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/avl.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-avlstuff.obj `if test -f 'mpdir/avlstuff.c'; then $(CYGPATH_W) 'mpdir/avlstuff.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/avlstuff.c'; fi` -libmpost_a-avlstuff.o: mpdir/avlstuff.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-avlstuff.o -MD -MP -MF $(DEPDIR)/libmpost_a-avlstuff.Tpo -c -o libmpost_a-avlstuff.o `test -f 'mpdir/avlstuff.c' || echo '$(srcdir)/'`mpdir/avlstuff.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-avlstuff.Tpo $(DEPDIR)/libmpost_a-avlstuff.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/avlstuff.c' object='libmpost_a-avlstuff.o' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-mapfile.o: mpdir/mapfile.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-mapfile.o -MD -MP -MF $(DEPDIR)/liboldmpost_a-mapfile.Tpo -c -o liboldmpost_a-mapfile.o `test -f 'mpdir/mapfile.c' || echo '$(srcdir)/'`mpdir/mapfile.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-mapfile.Tpo $(DEPDIR)/liboldmpost_a-mapfile.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/mapfile.c' object='liboldmpost_a-mapfile.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-avlstuff.o `test -f 'mpdir/avlstuff.c' || echo '$(srcdir)/'`mpdir/avlstuff.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-mapfile.o `test -f 'mpdir/mapfile.c' || echo '$(srcdir)/'`mpdir/mapfile.c -libmpost_a-avlstuff.obj: mpdir/avlstuff.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-avlstuff.obj -MD -MP -MF $(DEPDIR)/libmpost_a-avlstuff.Tpo -c -o libmpost_a-avlstuff.obj `if test -f 'mpdir/avlstuff.c'; then $(CYGPATH_W) 'mpdir/avlstuff.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/avlstuff.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-avlstuff.Tpo $(DEPDIR)/libmpost_a-avlstuff.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/avlstuff.c' object='libmpost_a-avlstuff.obj' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-mapfile.obj: mpdir/mapfile.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-mapfile.obj -MD -MP -MF $(DEPDIR)/liboldmpost_a-mapfile.Tpo -c -o liboldmpost_a-mapfile.obj `if test -f 'mpdir/mapfile.c'; then $(CYGPATH_W) 'mpdir/mapfile.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/mapfile.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-mapfile.Tpo $(DEPDIR)/liboldmpost_a-mapfile.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/mapfile.c' object='liboldmpost_a-mapfile.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-avlstuff.obj `if test -f 'mpdir/avlstuff.c'; then $(CYGPATH_W) 'mpdir/avlstuff.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/avlstuff.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-mapfile.obj `if test -f 'mpdir/mapfile.c'; then $(CYGPATH_W) 'mpdir/mapfile.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/mapfile.c'; fi` -libmpost_a-mapfile.o: mpdir/mapfile.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-mapfile.o -MD -MP -MF $(DEPDIR)/libmpost_a-mapfile.Tpo -c -o libmpost_a-mapfile.o `test -f 'mpdir/mapfile.c' || echo '$(srcdir)/'`mpdir/mapfile.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-mapfile.Tpo $(DEPDIR)/libmpost_a-mapfile.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/mapfile.c' object='libmpost_a-mapfile.o' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-turningnumber.o: mpdir/turningnumber.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-turningnumber.o -MD -MP -MF $(DEPDIR)/liboldmpost_a-turningnumber.Tpo -c -o liboldmpost_a-turningnumber.o `test -f 'mpdir/turningnumber.c' || echo '$(srcdir)/'`mpdir/turningnumber.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-turningnumber.Tpo $(DEPDIR)/liboldmpost_a-turningnumber.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/turningnumber.c' object='liboldmpost_a-turningnumber.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-mapfile.o `test -f 'mpdir/mapfile.c' || echo '$(srcdir)/'`mpdir/mapfile.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-turningnumber.o `test -f 'mpdir/turningnumber.c' || echo '$(srcdir)/'`mpdir/turningnumber.c -libmpost_a-mapfile.obj: mpdir/mapfile.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-mapfile.obj -MD -MP -MF $(DEPDIR)/libmpost_a-mapfile.Tpo -c -o libmpost_a-mapfile.obj `if test -f 'mpdir/mapfile.c'; then $(CYGPATH_W) 'mpdir/mapfile.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/mapfile.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-mapfile.Tpo $(DEPDIR)/libmpost_a-mapfile.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/mapfile.c' object='libmpost_a-mapfile.obj' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-turningnumber.obj: mpdir/turningnumber.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-turningnumber.obj -MD -MP -MF $(DEPDIR)/liboldmpost_a-turningnumber.Tpo -c -o liboldmpost_a-turningnumber.obj `if test -f 'mpdir/turningnumber.c'; then $(CYGPATH_W) 'mpdir/turningnumber.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/turningnumber.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-turningnumber.Tpo $(DEPDIR)/liboldmpost_a-turningnumber.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/turningnumber.c' object='liboldmpost_a-turningnumber.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-mapfile.obj `if test -f 'mpdir/mapfile.c'; then $(CYGPATH_W) 'mpdir/mapfile.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/mapfile.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-turningnumber.obj `if test -f 'mpdir/turningnumber.c'; then $(CYGPATH_W) 'mpdir/turningnumber.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/turningnumber.c'; fi` -libmpost_a-turningnumber.o: mpdir/turningnumber.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-turningnumber.o -MD -MP -MF $(DEPDIR)/libmpost_a-turningnumber.Tpo -c -o libmpost_a-turningnumber.o `test -f 'mpdir/turningnumber.c' || echo '$(srcdir)/'`mpdir/turningnumber.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-turningnumber.Tpo $(DEPDIR)/libmpost_a-turningnumber.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/turningnumber.c' object='libmpost_a-turningnumber.o' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-utils.o: mpdir/utils.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-utils.o -MD -MP -MF $(DEPDIR)/liboldmpost_a-utils.Tpo -c -o liboldmpost_a-utils.o `test -f 'mpdir/utils.c' || echo '$(srcdir)/'`mpdir/utils.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-utils.Tpo $(DEPDIR)/liboldmpost_a-utils.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/utils.c' object='liboldmpost_a-utils.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-turningnumber.o `test -f 'mpdir/turningnumber.c' || echo '$(srcdir)/'`mpdir/turningnumber.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-utils.o `test -f 'mpdir/utils.c' || echo '$(srcdir)/'`mpdir/utils.c -libmpost_a-turningnumber.obj: mpdir/turningnumber.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-turningnumber.obj -MD -MP -MF $(DEPDIR)/libmpost_a-turningnumber.Tpo -c -o libmpost_a-turningnumber.obj `if test -f 'mpdir/turningnumber.c'; then $(CYGPATH_W) 'mpdir/turningnumber.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/turningnumber.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-turningnumber.Tpo $(DEPDIR)/libmpost_a-turningnumber.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/turningnumber.c' object='libmpost_a-turningnumber.obj' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-utils.obj: mpdir/utils.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-utils.obj -MD -MP -MF $(DEPDIR)/liboldmpost_a-utils.Tpo -c -o liboldmpost_a-utils.obj `if test -f 'mpdir/utils.c'; then $(CYGPATH_W) 'mpdir/utils.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/utils.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-utils.Tpo $(DEPDIR)/liboldmpost_a-utils.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/utils.c' object='liboldmpost_a-utils.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-turningnumber.obj `if test -f 'mpdir/turningnumber.c'; then $(CYGPATH_W) 'mpdir/turningnumber.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/turningnumber.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-utils.obj `if test -f 'mpdir/utils.c'; then $(CYGPATH_W) 'mpdir/utils.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/utils.c'; fi` -libmpost_a-utils.o: mpdir/utils.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-utils.o -MD -MP -MF $(DEPDIR)/libmpost_a-utils.Tpo -c -o libmpost_a-utils.o `test -f 'mpdir/utils.c' || echo '$(srcdir)/'`mpdir/utils.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-utils.Tpo $(DEPDIR)/libmpost_a-utils.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/utils.c' object='libmpost_a-utils.o' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-writeenc.o: mpdir/writeenc.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-writeenc.o -MD -MP -MF $(DEPDIR)/liboldmpost_a-writeenc.Tpo -c -o liboldmpost_a-writeenc.o `test -f 'mpdir/writeenc.c' || echo '$(srcdir)/'`mpdir/writeenc.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-writeenc.Tpo $(DEPDIR)/liboldmpost_a-writeenc.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/writeenc.c' object='liboldmpost_a-writeenc.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-utils.o `test -f 'mpdir/utils.c' || echo '$(srcdir)/'`mpdir/utils.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-writeenc.o `test -f 'mpdir/writeenc.c' || echo '$(srcdir)/'`mpdir/writeenc.c -libmpost_a-utils.obj: mpdir/utils.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-utils.obj -MD -MP -MF $(DEPDIR)/libmpost_a-utils.Tpo -c -o libmpost_a-utils.obj `if test -f 'mpdir/utils.c'; then $(CYGPATH_W) 'mpdir/utils.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/utils.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-utils.Tpo $(DEPDIR)/libmpost_a-utils.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/utils.c' object='libmpost_a-utils.obj' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-writeenc.obj: mpdir/writeenc.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-writeenc.obj -MD -MP -MF $(DEPDIR)/liboldmpost_a-writeenc.Tpo -c -o liboldmpost_a-writeenc.obj `if test -f 'mpdir/writeenc.c'; then $(CYGPATH_W) 'mpdir/writeenc.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/writeenc.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-writeenc.Tpo $(DEPDIR)/liboldmpost_a-writeenc.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/writeenc.c' object='liboldmpost_a-writeenc.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-utils.obj `if test -f 'mpdir/utils.c'; then $(CYGPATH_W) 'mpdir/utils.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/utils.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-writeenc.obj `if test -f 'mpdir/writeenc.c'; then $(CYGPATH_W) 'mpdir/writeenc.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/writeenc.c'; fi` -libmpost_a-writeenc.o: mpdir/writeenc.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-writeenc.o -MD -MP -MF $(DEPDIR)/libmpost_a-writeenc.Tpo -c -o libmpost_a-writeenc.o `test -f 'mpdir/writeenc.c' || echo '$(srcdir)/'`mpdir/writeenc.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-writeenc.Tpo $(DEPDIR)/libmpost_a-writeenc.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/writeenc.c' object='libmpost_a-writeenc.o' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-writefont.o: mpdir/writefont.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-writefont.o -MD -MP -MF $(DEPDIR)/liboldmpost_a-writefont.Tpo -c -o liboldmpost_a-writefont.o `test -f 'mpdir/writefont.c' || echo '$(srcdir)/'`mpdir/writefont.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-writefont.Tpo $(DEPDIR)/liboldmpost_a-writefont.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/writefont.c' object='liboldmpost_a-writefont.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-writeenc.o `test -f 'mpdir/writeenc.c' || echo '$(srcdir)/'`mpdir/writeenc.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-writefont.o `test -f 'mpdir/writefont.c' || echo '$(srcdir)/'`mpdir/writefont.c -libmpost_a-writeenc.obj: mpdir/writeenc.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-writeenc.obj -MD -MP -MF $(DEPDIR)/libmpost_a-writeenc.Tpo -c -o libmpost_a-writeenc.obj `if test -f 'mpdir/writeenc.c'; then $(CYGPATH_W) 'mpdir/writeenc.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/writeenc.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-writeenc.Tpo $(DEPDIR)/libmpost_a-writeenc.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/writeenc.c' object='libmpost_a-writeenc.obj' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-writefont.obj: mpdir/writefont.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-writefont.obj -MD -MP -MF $(DEPDIR)/liboldmpost_a-writefont.Tpo -c -o liboldmpost_a-writefont.obj `if test -f 'mpdir/writefont.c'; then $(CYGPATH_W) 'mpdir/writefont.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/writefont.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-writefont.Tpo $(DEPDIR)/liboldmpost_a-writefont.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/writefont.c' object='liboldmpost_a-writefont.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-writeenc.obj `if test -f 'mpdir/writeenc.c'; then $(CYGPATH_W) 'mpdir/writeenc.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/writeenc.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-writefont.obj `if test -f 'mpdir/writefont.c'; then $(CYGPATH_W) 'mpdir/writefont.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/writefont.c'; fi` -libmpost_a-writefont.o: mpdir/writefont.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-writefont.o -MD -MP -MF $(DEPDIR)/libmpost_a-writefont.Tpo -c -o libmpost_a-writefont.o `test -f 'mpdir/writefont.c' || echo '$(srcdir)/'`mpdir/writefont.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-writefont.Tpo $(DEPDIR)/libmpost_a-writefont.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/writefont.c' object='libmpost_a-writefont.o' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-writet1.o: mpdir/writet1.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-writet1.o -MD -MP -MF $(DEPDIR)/liboldmpost_a-writet1.Tpo -c -o liboldmpost_a-writet1.o `test -f 'mpdir/writet1.c' || echo '$(srcdir)/'`mpdir/writet1.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-writet1.Tpo $(DEPDIR)/liboldmpost_a-writet1.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/writet1.c' object='liboldmpost_a-writet1.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-writefont.o `test -f 'mpdir/writefont.c' || echo '$(srcdir)/'`mpdir/writefont.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-writet1.o `test -f 'mpdir/writet1.c' || echo '$(srcdir)/'`mpdir/writet1.c -libmpost_a-writefont.obj: mpdir/writefont.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-writefont.obj -MD -MP -MF $(DEPDIR)/libmpost_a-writefont.Tpo -c -o libmpost_a-writefont.obj `if test -f 'mpdir/writefont.c'; then $(CYGPATH_W) 'mpdir/writefont.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/writefont.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-writefont.Tpo $(DEPDIR)/libmpost_a-writefont.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/writefont.c' object='libmpost_a-writefont.obj' libtool=no @AMDEPBACKSLASH@ +liboldmpost_a-writet1.obj: mpdir/writet1.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT liboldmpost_a-writet1.obj -MD -MP -MF $(DEPDIR)/liboldmpost_a-writet1.Tpo -c -o liboldmpost_a-writet1.obj `if test -f 'mpdir/writet1.c'; then $(CYGPATH_W) 'mpdir/writet1.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/writet1.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/liboldmpost_a-writet1.Tpo $(DEPDIR)/liboldmpost_a-writet1.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/writet1.c' object='liboldmpost_a-writet1.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-writefont.obj `if test -f 'mpdir/writefont.c'; then $(CYGPATH_W) 'mpdir/writefont.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/writefont.c'; fi` - -libmpost_a-writet1.o: mpdir/writet1.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-writet1.o -MD -MP -MF $(DEPDIR)/libmpost_a-writet1.Tpo -c -o libmpost_a-writet1.o `test -f 'mpdir/writet1.c' || echo '$(srcdir)/'`mpdir/writet1.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-writet1.Tpo $(DEPDIR)/libmpost_a-writet1.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/writet1.c' object='libmpost_a-writet1.o' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-writet1.o `test -f 'mpdir/writet1.c' || echo '$(srcdir)/'`mpdir/writet1.c - -libmpost_a-writet1.obj: mpdir/writet1.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libmpost_a-writet1.obj -MD -MP -MF $(DEPDIR)/libmpost_a-writet1.Tpo -c -o libmpost_a-writet1.obj `if test -f 'mpdir/writet1.c'; then $(CYGPATH_W) 'mpdir/writet1.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/writet1.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/libmpost_a-writet1.Tpo $(DEPDIR)/libmpost_a-writet1.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpdir/writet1.c' object='libmpost_a-writet1.obj' libtool=no @AMDEPBACKSLASH@ -@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o libmpost_a-writet1.obj `if test -f 'mpdir/writet1.c'; then $(CYGPATH_W) 'mpdir/writet1.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/writet1.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(liboldmpost_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o liboldmpost_a-writet1.obj `if test -f 'mpdir/writet1.c'; then $(CYGPATH_W) 'mpdir/writet1.c'; else $(CYGPATH_W) '$(srcdir)/mpdir/writet1.c'; fi` libpdftex_a-avl.o: pdftexdir/avl.c @am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(libpdftex_a_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT libpdftex_a-avl.o -MD -MP -MF $(DEPDIR)/libpdftex_a-avl.Tpo -c -o libpdftex_a-avl.o `test -f 'pdftexdir/avl.c' || echo '$(srcdir)/'`pdftexdir/avl.c @@ -6389,117 +6428,117 @@ mf_nowin-mfextra.obj: mfextra.c @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mf_nowin_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mf_nowin-mfextra.obj `if test -f 'mfextra.c'; then $(CYGPATH_W) 'mfextra.c'; else $(CYGPATH_W) '$(srcdir)/mfextra.c'; fi` -mpost-mpini.o: mpini.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mpini.o -MD -MP -MF $(DEPDIR)/mpost-mpini.Tpo -c -o mpost-mpini.o `test -f 'mpini.c' || echo '$(srcdir)/'`mpini.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mpini.Tpo $(DEPDIR)/mpost-mpini.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpini.c' object='mpost-mpini.o' libtool=no @AMDEPBACKSLASH@ +mpost-mpost.o: mpost.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mpost.o -MD -MP -MF $(DEPDIR)/mpost-mpost.Tpo -c -o mpost-mpost.o `test -f 'mpost.c' || echo '$(srcdir)/'`mpost.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mpost.Tpo $(DEPDIR)/mpost-mpost.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpost.c' object='mpost-mpost.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mpini.o `test -f 'mpini.c' || echo '$(srcdir)/'`mpini.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mpost.o `test -f 'mpost.c' || echo '$(srcdir)/'`mpost.c -mpost-mpini.obj: mpini.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mpini.obj -MD -MP -MF $(DEPDIR)/mpost-mpini.Tpo -c -o mpost-mpini.obj `if test -f 'mpini.c'; then $(CYGPATH_W) 'mpini.c'; else $(CYGPATH_W) '$(srcdir)/mpini.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mpini.Tpo $(DEPDIR)/mpost-mpini.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpini.c' object='mpost-mpini.obj' libtool=no @AMDEPBACKSLASH@ +mpost-mpost.obj: mpost.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mpost.obj -MD -MP -MF $(DEPDIR)/mpost-mpost.Tpo -c -o mpost-mpost.obj `if test -f 'mpost.c'; then $(CYGPATH_W) 'mpost.c'; else $(CYGPATH_W) '$(srcdir)/mpost.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mpost.Tpo $(DEPDIR)/mpost-mpost.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpost.c' object='mpost-mpost.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mpini.obj `if test -f 'mpini.c'; then $(CYGPATH_W) 'mpini.c'; else $(CYGPATH_W) '$(srcdir)/mpini.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mpost.obj `if test -f 'mpost.c'; then $(CYGPATH_W) 'mpost.c'; else $(CYGPATH_W) '$(srcdir)/mpost.c'; fi` -mpost-mp0.o: mp0.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mp0.o -MD -MP -MF $(DEPDIR)/mpost-mp0.Tpo -c -o mpost-mp0.o `test -f 'mp0.c' || echo '$(srcdir)/'`mp0.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mp0.Tpo $(DEPDIR)/mpost-mp0.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp0.c' object='mpost-mp0.o' libtool=no @AMDEPBACKSLASH@ +mpost-mpxout.o: mpxout.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mpxout.o -MD -MP -MF $(DEPDIR)/mpost-mpxout.Tpo -c -o mpost-mpxout.o `test -f 'mpxout.c' || echo '$(srcdir)/'`mpxout.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mpxout.Tpo $(DEPDIR)/mpost-mpxout.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpxout.c' object='mpost-mpxout.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mp0.o `test -f 'mp0.c' || echo '$(srcdir)/'`mp0.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mpxout.o `test -f 'mpxout.c' || echo '$(srcdir)/'`mpxout.c -mpost-mp0.obj: mp0.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mp0.obj -MD -MP -MF $(DEPDIR)/mpost-mp0.Tpo -c -o mpost-mp0.obj `if test -f 'mp0.c'; then $(CYGPATH_W) 'mp0.c'; else $(CYGPATH_W) '$(srcdir)/mp0.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mp0.Tpo $(DEPDIR)/mpost-mp0.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp0.c' object='mpost-mp0.obj' libtool=no @AMDEPBACKSLASH@ +mpost-mpxout.obj: mpxout.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mpxout.obj -MD -MP -MF $(DEPDIR)/mpost-mpxout.Tpo -c -o mpost-mpxout.obj `if test -f 'mpxout.c'; then $(CYGPATH_W) 'mpxout.c'; else $(CYGPATH_W) '$(srcdir)/mpxout.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mpxout.Tpo $(DEPDIR)/mpost-mpxout.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpxout.c' object='mpost-mpxout.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mp0.obj `if test -f 'mp0.c'; then $(CYGPATH_W) 'mp0.c'; else $(CYGPATH_W) '$(srcdir)/mp0.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mpxout.obj `if test -f 'mpxout.c'; then $(CYGPATH_W) 'mpxout.c'; else $(CYGPATH_W) '$(srcdir)/mpxout.c'; fi` -mpost-mp1.o: mp1.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mp1.o -MD -MP -MF $(DEPDIR)/mpost-mp1.Tpo -c -o mpost-mp1.o `test -f 'mp1.c' || echo '$(srcdir)/'`mp1.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mp1.Tpo $(DEPDIR)/mpost-mp1.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp1.c' object='mpost-mp1.o' libtool=no @AMDEPBACKSLASH@ +oldmpost-mpini.o: mpini.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT oldmpost-mpini.o -MD -MP -MF $(DEPDIR)/oldmpost-mpini.Tpo -c -o oldmpost-mpini.o `test -f 'mpini.c' || echo '$(srcdir)/'`mpini.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/oldmpost-mpini.Tpo $(DEPDIR)/oldmpost-mpini.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpini.c' object='oldmpost-mpini.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mp1.o `test -f 'mp1.c' || echo '$(srcdir)/'`mp1.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o oldmpost-mpini.o `test -f 'mpini.c' || echo '$(srcdir)/'`mpini.c -mpost-mp1.obj: mp1.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mp1.obj -MD -MP -MF $(DEPDIR)/mpost-mp1.Tpo -c -o mpost-mp1.obj `if test -f 'mp1.c'; then $(CYGPATH_W) 'mp1.c'; else $(CYGPATH_W) '$(srcdir)/mp1.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mp1.Tpo $(DEPDIR)/mpost-mp1.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp1.c' object='mpost-mp1.obj' libtool=no @AMDEPBACKSLASH@ +oldmpost-mpini.obj: mpini.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT oldmpost-mpini.obj -MD -MP -MF $(DEPDIR)/oldmpost-mpini.Tpo -c -o oldmpost-mpini.obj `if test -f 'mpini.c'; then $(CYGPATH_W) 'mpini.c'; else $(CYGPATH_W) '$(srcdir)/mpini.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/oldmpost-mpini.Tpo $(DEPDIR)/oldmpost-mpini.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpini.c' object='oldmpost-mpini.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mp1.obj `if test -f 'mp1.c'; then $(CYGPATH_W) 'mp1.c'; else $(CYGPATH_W) '$(srcdir)/mp1.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o oldmpost-mpini.obj `if test -f 'mpini.c'; then $(CYGPATH_W) 'mpini.c'; else $(CYGPATH_W) '$(srcdir)/mpini.c'; fi` -mpost-mp2.o: mp2.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mp2.o -MD -MP -MF $(DEPDIR)/mpost-mp2.Tpo -c -o mpost-mp2.o `test -f 'mp2.c' || echo '$(srcdir)/'`mp2.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mp2.Tpo $(DEPDIR)/mpost-mp2.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp2.c' object='mpost-mp2.o' libtool=no @AMDEPBACKSLASH@ +oldmpost-mp0.o: mp0.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT oldmpost-mp0.o -MD -MP -MF $(DEPDIR)/oldmpost-mp0.Tpo -c -o oldmpost-mp0.o `test -f 'mp0.c' || echo '$(srcdir)/'`mp0.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/oldmpost-mp0.Tpo $(DEPDIR)/oldmpost-mp0.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp0.c' object='oldmpost-mp0.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mp2.o `test -f 'mp2.c' || echo '$(srcdir)/'`mp2.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o oldmpost-mp0.o `test -f 'mp0.c' || echo '$(srcdir)/'`mp0.c -mpost-mp2.obj: mp2.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mp2.obj -MD -MP -MF $(DEPDIR)/mpost-mp2.Tpo -c -o mpost-mp2.obj `if test -f 'mp2.c'; then $(CYGPATH_W) 'mp2.c'; else $(CYGPATH_W) '$(srcdir)/mp2.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mp2.Tpo $(DEPDIR)/mpost-mp2.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp2.c' object='mpost-mp2.obj' libtool=no @AMDEPBACKSLASH@ +oldmpost-mp0.obj: mp0.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT oldmpost-mp0.obj -MD -MP -MF $(DEPDIR)/oldmpost-mp0.Tpo -c -o oldmpost-mp0.obj `if test -f 'mp0.c'; then $(CYGPATH_W) 'mp0.c'; else $(CYGPATH_W) '$(srcdir)/mp0.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/oldmpost-mp0.Tpo $(DEPDIR)/oldmpost-mp0.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp0.c' object='oldmpost-mp0.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mp2.obj `if test -f 'mp2.c'; then $(CYGPATH_W) 'mp2.c'; else $(CYGPATH_W) '$(srcdir)/mp2.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o oldmpost-mp0.obj `if test -f 'mp0.c'; then $(CYGPATH_W) 'mp0.c'; else $(CYGPATH_W) '$(srcdir)/mp0.c'; fi` -mpost-mp-pool.o: mp-pool.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mp-pool.o -MD -MP -MF $(DEPDIR)/mpost-mp-pool.Tpo -c -o mpost-mp-pool.o `test -f 'mp-pool.c' || echo '$(srcdir)/'`mp-pool.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mp-pool.Tpo $(DEPDIR)/mpost-mp-pool.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp-pool.c' object='mpost-mp-pool.o' libtool=no @AMDEPBACKSLASH@ +oldmpost-mp1.o: mp1.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT oldmpost-mp1.o -MD -MP -MF $(DEPDIR)/oldmpost-mp1.Tpo -c -o oldmpost-mp1.o `test -f 'mp1.c' || echo '$(srcdir)/'`mp1.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/oldmpost-mp1.Tpo $(DEPDIR)/oldmpost-mp1.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp1.c' object='oldmpost-mp1.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mp-pool.o `test -f 'mp-pool.c' || echo '$(srcdir)/'`mp-pool.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o oldmpost-mp1.o `test -f 'mp1.c' || echo '$(srcdir)/'`mp1.c -mpost-mp-pool.obj: mp-pool.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mp-pool.obj -MD -MP -MF $(DEPDIR)/mpost-mp-pool.Tpo -c -o mpost-mp-pool.obj `if test -f 'mp-pool.c'; then $(CYGPATH_W) 'mp-pool.c'; else $(CYGPATH_W) '$(srcdir)/mp-pool.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mp-pool.Tpo $(DEPDIR)/mpost-mp-pool.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp-pool.c' object='mpost-mp-pool.obj' libtool=no @AMDEPBACKSLASH@ +oldmpost-mp1.obj: mp1.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT oldmpost-mp1.obj -MD -MP -MF $(DEPDIR)/oldmpost-mp1.Tpo -c -o oldmpost-mp1.obj `if test -f 'mp1.c'; then $(CYGPATH_W) 'mp1.c'; else $(CYGPATH_W) '$(srcdir)/mp1.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/oldmpost-mp1.Tpo $(DEPDIR)/oldmpost-mp1.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp1.c' object='oldmpost-mp1.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mp-pool.obj `if test -f 'mp-pool.c'; then $(CYGPATH_W) 'mp-pool.c'; else $(CYGPATH_W) '$(srcdir)/mp-pool.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o oldmpost-mp1.obj `if test -f 'mp1.c'; then $(CYGPATH_W) 'mp1.c'; else $(CYGPATH_W) '$(srcdir)/mp1.c'; fi` -mpost-mpextra.o: mpextra.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mpextra.o -MD -MP -MF $(DEPDIR)/mpost-mpextra.Tpo -c -o mpost-mpextra.o `test -f 'mpextra.c' || echo '$(srcdir)/'`mpextra.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mpextra.Tpo $(DEPDIR)/mpost-mpextra.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpextra.c' object='mpost-mpextra.o' libtool=no @AMDEPBACKSLASH@ +oldmpost-mp2.o: mp2.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT oldmpost-mp2.o -MD -MP -MF $(DEPDIR)/oldmpost-mp2.Tpo -c -o oldmpost-mp2.o `test -f 'mp2.c' || echo '$(srcdir)/'`mp2.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/oldmpost-mp2.Tpo $(DEPDIR)/oldmpost-mp2.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp2.c' object='oldmpost-mp2.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mpextra.o `test -f 'mpextra.c' || echo '$(srcdir)/'`mpextra.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o oldmpost-mp2.o `test -f 'mp2.c' || echo '$(srcdir)/'`mp2.c -mpost-mpextra.obj: mpextra.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT mpost-mpextra.obj -MD -MP -MF $(DEPDIR)/mpost-mpextra.Tpo -c -o mpost-mpextra.obj `if test -f 'mpextra.c'; then $(CYGPATH_W) 'mpextra.c'; else $(CYGPATH_W) '$(srcdir)/mpextra.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/mpost-mpextra.Tpo $(DEPDIR)/mpost-mpextra.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpextra.c' object='mpost-mpextra.obj' libtool=no @AMDEPBACKSLASH@ +oldmpost-mp2.obj: mp2.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT oldmpost-mp2.obj -MD -MP -MF $(DEPDIR)/oldmpost-mp2.Tpo -c -o oldmpost-mp2.obj `if test -f 'mp2.c'; then $(CYGPATH_W) 'mp2.c'; else $(CYGPATH_W) '$(srcdir)/mp2.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/oldmpost-mp2.Tpo $(DEPDIR)/oldmpost-mp2.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp2.c' object='oldmpost-mp2.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(mpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o mpost-mpextra.obj `if test -f 'mpextra.c'; then $(CYGPATH_W) 'mpextra.c'; else $(CYGPATH_W) '$(srcdir)/mpextra.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o oldmpost-mp2.obj `if test -f 'mp2.c'; then $(CYGPATH_W) 'mp2.c'; else $(CYGPATH_W) '$(srcdir)/mp2.c'; fi` -newmpost-mpost.o: mpost.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(newmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT newmpost-mpost.o -MD -MP -MF $(DEPDIR)/newmpost-mpost.Tpo -c -o newmpost-mpost.o `test -f 'mpost.c' || echo '$(srcdir)/'`mpost.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/newmpost-mpost.Tpo $(DEPDIR)/newmpost-mpost.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpost.c' object='newmpost-mpost.o' libtool=no @AMDEPBACKSLASH@ +oldmpost-mp-pool.o: mp-pool.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT oldmpost-mp-pool.o -MD -MP -MF $(DEPDIR)/oldmpost-mp-pool.Tpo -c -o oldmpost-mp-pool.o `test -f 'mp-pool.c' || echo '$(srcdir)/'`mp-pool.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/oldmpost-mp-pool.Tpo $(DEPDIR)/oldmpost-mp-pool.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp-pool.c' object='oldmpost-mp-pool.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(newmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o newmpost-mpost.o `test -f 'mpost.c' || echo '$(srcdir)/'`mpost.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o oldmpost-mp-pool.o `test -f 'mp-pool.c' || echo '$(srcdir)/'`mp-pool.c -newmpost-mpost.obj: mpost.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(newmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT newmpost-mpost.obj -MD -MP -MF $(DEPDIR)/newmpost-mpost.Tpo -c -o newmpost-mpost.obj `if test -f 'mpost.c'; then $(CYGPATH_W) 'mpost.c'; else $(CYGPATH_W) '$(srcdir)/mpost.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/newmpost-mpost.Tpo $(DEPDIR)/newmpost-mpost.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpost.c' object='newmpost-mpost.obj' libtool=no @AMDEPBACKSLASH@ +oldmpost-mp-pool.obj: mp-pool.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT oldmpost-mp-pool.obj -MD -MP -MF $(DEPDIR)/oldmpost-mp-pool.Tpo -c -o oldmpost-mp-pool.obj `if test -f 'mp-pool.c'; then $(CYGPATH_W) 'mp-pool.c'; else $(CYGPATH_W) '$(srcdir)/mp-pool.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/oldmpost-mp-pool.Tpo $(DEPDIR)/oldmpost-mp-pool.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mp-pool.c' object='oldmpost-mp-pool.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(newmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o newmpost-mpost.obj `if test -f 'mpost.c'; then $(CYGPATH_W) 'mpost.c'; else $(CYGPATH_W) '$(srcdir)/mpost.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o oldmpost-mp-pool.obj `if test -f 'mp-pool.c'; then $(CYGPATH_W) 'mp-pool.c'; else $(CYGPATH_W) '$(srcdir)/mp-pool.c'; fi` -newmpost-mpxout.o: mpxout.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(newmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT newmpost-mpxout.o -MD -MP -MF $(DEPDIR)/newmpost-mpxout.Tpo -c -o newmpost-mpxout.o `test -f 'mpxout.c' || echo '$(srcdir)/'`mpxout.c -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/newmpost-mpxout.Tpo $(DEPDIR)/newmpost-mpxout.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpxout.c' object='newmpost-mpxout.o' libtool=no @AMDEPBACKSLASH@ +oldmpost-mpextra.o: mpextra.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT oldmpost-mpextra.o -MD -MP -MF $(DEPDIR)/oldmpost-mpextra.Tpo -c -o oldmpost-mpextra.o `test -f 'mpextra.c' || echo '$(srcdir)/'`mpextra.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/oldmpost-mpextra.Tpo $(DEPDIR)/oldmpost-mpextra.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpextra.c' object='oldmpost-mpextra.o' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(newmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o newmpost-mpxout.o `test -f 'mpxout.c' || echo '$(srcdir)/'`mpxout.c +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o oldmpost-mpextra.o `test -f 'mpextra.c' || echo '$(srcdir)/'`mpextra.c -newmpost-mpxout.obj: mpxout.c -@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(newmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT newmpost-mpxout.obj -MD -MP -MF $(DEPDIR)/newmpost-mpxout.Tpo -c -o newmpost-mpxout.obj `if test -f 'mpxout.c'; then $(CYGPATH_W) 'mpxout.c'; else $(CYGPATH_W) '$(srcdir)/mpxout.c'; fi` -@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/newmpost-mpxout.Tpo $(DEPDIR)/newmpost-mpxout.Po -@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpxout.c' object='newmpost-mpxout.obj' libtool=no @AMDEPBACKSLASH@ +oldmpost-mpextra.obj: mpextra.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT oldmpost-mpextra.obj -MD -MP -MF $(DEPDIR)/oldmpost-mpextra.Tpo -c -o oldmpost-mpextra.obj `if test -f 'mpextra.c'; then $(CYGPATH_W) 'mpextra.c'; else $(CYGPATH_W) '$(srcdir)/mpextra.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/oldmpost-mpextra.Tpo $(DEPDIR)/oldmpost-mpextra.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='mpextra.c' object='oldmpost-mpextra.obj' libtool=no @AMDEPBACKSLASH@ @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ -@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(newmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o newmpost-mpxout.obj `if test -f 'mpxout.c'; then $(CYGPATH_W) 'mpxout.c'; else $(CYGPATH_W) '$(srcdir)/mpxout.c'; fi` +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(oldmpost_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o oldmpost-mpextra.obj `if test -f 'mpextra.c'; then $(CYGPATH_W) 'mpextra.c'; else $(CYGPATH_W) '$(srcdir)/mpextra.c'; fi` pdftex-pdftexini.o: pdftexini.c @am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(pdftex_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT pdftex-pdftexini.o -MD -MP -MF $(DEPDIR)/pdftex-pdftexini.Tpo -c -o pdftex-pdftexini.o `test -f 'pdftexini.c' || echo '$(srcdir)/'`pdftexini.c @@ -6851,6 +6890,20 @@ xetex-xetexextra.obj: xetexextra.c @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(xetex_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o xetex-xetexextra.obj `if test -f 'xetexextra.c'; then $(CYGPATH_W) 'xetexextra.c'; else $(CYGPATH_W) '$(srcdir)/xetexextra.c'; fi` +xetex-synctex-xe.o: synctex-xe.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(xetex_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT xetex-synctex-xe.o -MD -MP -MF $(DEPDIR)/xetex-synctex-xe.Tpo -c -o xetex-synctex-xe.o `test -f 'synctex-xe.c' || echo '$(srcdir)/'`synctex-xe.c +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/xetex-synctex-xe.Tpo $(DEPDIR)/xetex-synctex-xe.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='synctex-xe.c' object='xetex-synctex-xe.o' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(xetex_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o xetex-synctex-xe.o `test -f 'synctex-xe.c' || echo '$(srcdir)/'`synctex-xe.c + +xetex-synctex-xe.obj: synctex-xe.c +@am__fastdepCC_TRUE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(xetex_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT xetex-synctex-xe.obj -MD -MP -MF $(DEPDIR)/xetex-synctex-xe.Tpo -c -o xetex-synctex-xe.obj `if test -f 'synctex-xe.c'; then $(CYGPATH_W) 'synctex-xe.c'; else $(CYGPATH_W) '$(srcdir)/synctex-xe.c'; fi` +@am__fastdepCC_TRUE@ mv -f $(DEPDIR)/xetex-synctex-xe.Tpo $(DEPDIR)/xetex-synctex-xe.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='synctex-xe.c' object='xetex-synctex-xe.obj' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(xetex_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o xetex-synctex-xe.obj `if test -f 'synctex-xe.c'; then $(CYGPATH_W) 'synctex-xe.c'; else $(CYGPATH_W) '$(srcdir)/synctex-xe.c'; fi` + .cc.o: @am__fastdepCXX_TRUE@ $(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< @am__fastdepCXX_TRUE@ mv -f $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po @@ -8024,11 +8077,11 @@ mf-final.ch: $(TIE) mf.web mf.ch mf-binpool.ch $(tie) -c $@ mf.web mf.ch mf-binpool.ch mf-pool.c: mf.pool $(makecpool) tmf-pool.h $(makecpool) mf.pool $(srcdir)/tmf-pool.h >$@ || rm -f $@ -$(mpost_c_h): mp-web2c +$(oldmpost_c_h): mp-web2c mp-web2c: mp.p $(web2c_texmf) mpdir/mp.defines web2c/cvtmf1.sed web2c/cvtmf2.sed $(web2c) mp echo timestamp >$@ - touch $(mpost_c_h) + touch $(oldmpost_c_h) mpextra.c: lib/texmfmp.c mpd.h sed s/TEX-OR-MF-OR-MP/mp/ $(srcdir)/lib/texmfmp.c >$@ mp.p mp.pool: mp-tangle @@ -8039,48 +8092,76 @@ mp-tangle: tangle$(EXEEXT) mp.web mp.ch mp-pool.c: mp.pool $(makecpool) mpdir/mplib.h $(makecpool) mp.pool $(srcdir)/mpdir/mplib.h >$@ || rm -f $@ -$(libmpost_a_OBJECTS): mpd.h +$(liboldmpost_a_OBJECTS): mpd.h + +mpost.c: ctangle$(EXEEXT) mplibdir/mpost.w + $(mp_ctangle) mpost.w + +$(mpxout_c_h): mpxout-ctangle +mpxout-ctangle: ctangle$(EXEEXT) mplibdir/mpxout.w + $(mp_ctangle) mpxout.w + echo timestamp >$@ + touch $(mpxout_c_h) + +$(mpost_OBJECTS): $(nodist_mpost_SOURCES) libmplib.a -$(newmpost_c_h): mpost-ctangle libmplib.a -mpost-ctangle: ctangle$(EXEEXT) $(newmpost_web) - CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) mpost.w - CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) mpxout.w +memio.c: ctangle$(EXEEXT) mplibdir/memio.w + $(mp_ctangle) memio.w + +tfmin.c: ctangle$(EXEEXT) mplibdir/tfmin.w + $(mp_ctangle) tfmin.w + +$(mp_c_h): mp-ctangle +mp-ctangle: ctangle$(EXEEXT) mplibdir/mp.w + $(mp_ctangle) mp.w + echo timestamp >$@ + touch $(mp_c_h) + +$(psout_c_h): psout-ctangle +psout-ctangle: ctangle$(EXEEXT) mplibdir/psout.w + $(mp_ctangle) psout.w echo timestamp >$@ - touch $(newmpost_c_h) - -$(libmplib_c_h): mplib-ctangle $(libmplib_true_c) -mplib-ctangle: ctangle$(EXEEXT) $(libmplib_web) - CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) mp.w - CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) psout.w - CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) svgout.w - CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) tfmin.w - CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) memio.w + touch $(psout_c_h) + +$(svgout_c_h): svgout-ctangle +svgout-ctangle: ctangle$(EXEEXT) mplibdir/svgout.w + $(mp_ctangle) svgout.w echo timestamp >$@ - touch $(libmplib_c_h) + touch $(svgout_c_h) + +$(libmplib_a_OBJECTS): $(nodist_libmplib_a_SOURCES) + $(etex_c_h): etex-web2c etex-web2c: etex.p $(web2c_texmf) $(web2c) etex : $(synctex_convert_etex) echo timestamp >$@ touch $(etex_c_h) + +etex-pool.c: etex.pool $(makecpool) tmf-pool.h + $(makecpool) etex.pool $(srcdir)/tmf-pool.h >$@ || rm -f $@ + etexextra.c: etexdir/etexextra.h lib/texmfmp.c etexd.h sed s/TEX-OR-MF-OR-MP/etex/ $(srcdir)/lib/texmfmp.c >$@ + +etexdir/etexextra.h: etexdir/etexextra.in etexdir/etex.version + sed s/ETEX-VERSION/`cat etexdir/etex.version`/ \ + $(srcdir)/etexdir/etexextra.in >$@ + etex.p etex.pool: etex-tangle etex-tangle: tangle$(EXEEXT) etex.web etex.ch $(tangle) etex etex echo timestamp >$@ touch etex.p etex.pool -etex-pool.c: etex.pool $(makecpool) tmf-pool.h - $(makecpool) etex.pool $(srcdir)/tmf-pool.h >$@ || rm -f $@ + etexdir/etex.version: etexdir/etex.ch $(mkdir_p) etexdir grep '^@d eTeX_version_string==' $(srcdir)/etexdir/etex.ch \ | sed "s/^.*'-//;s/'.*$$//" >etexdir/etex.version -etexdir/etexextra.h: etexdir/etexextra.in etexdir/etex.version - sed s/ETEX-VERSION/`cat etexdir/etex.version`/ \ - $(srcdir)/etexdir/etexextra.in >$@ + etex.web: $(TIE) $(etex_web_srcs) $(tie) -m etex.web $(etex_web_srcs) + etex.ch: $(TIE) etex.web $(etex_ch_srcs) $(tie) -c etex.ch etex.web $(etex_ch_srcs) $(pdftex_c_h): pdftex-web2c @@ -8249,15 +8330,16 @@ aleph-web2c: aleph.p $(web2c_texmf) alephdir/aleph.defines $(web2c) aleph echo timestamp >$@ touch $(aleph_c_h) +aleph-pool.c: aleph.pool $(makecpool) alephdir/aleph-pool.h + $(makecpool) aleph.pool $(srcdir)/alephdir/aleph-pool.h >$@ || rm -f $@ alephextra.c: lib/texmfmp.c alephdir/alephextra.h alephd.h sed s/TEX-OR-MF-OR-MP/aleph/ $(srcdir)/lib/texmfmp.c >$@ + aleph.p aleph.pool: aleph-tangle aleph-tangle: otangle$(EXEEXT) aleph.web aleph.ch $(otangle) aleph aleph echo timestamp >$@ touch aleph.p aleph.pool -aleph-pool.c: aleph.pool $(makecpool) alephdir/aleph-pool.h - $(makecpool) aleph.pool $(srcdir)/alephdir/aleph-pool.h >$@ || rm -f $@ aleph.web: $(TIE) $(aleph_web_srcs) $(tie) -m aleph.web $(aleph_web_srcs) aleph.ch: $(TIE) aleph.web $(aleph_ch_srcs) @@ -8271,6 +8353,9 @@ synctex-e.c: etexd.h synctexdir/synctex.c $(dist_etex_SOURCES) synctex-pdf.c: pdftexd.h synctexdir/synctex.c $(dist_pdftex_SOURCES) sed s/TEX-OR-MF-OR-MP/pdftex/ $(srcdir)/synctexdir/synctex.c >$@ + +synctex-xe.c: xetexd.h synctexdir/synctex.c $(dist_xetex_SOURCES) + sed s/TEX-OR-MF-OR-MP/xetex/ $(srcdir)/synctexdir/synctex.c >$@ # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. .NOEXPORT: diff --git a/Build/source/texk/web2c/luatexdir/am/luatex.am b/Build/source/texk/web2c/luatexdir/am/luatex.am index c607dd8e570..bdfa8ebca40 100644 --- a/Build/source/texk/web2c/luatexdir/am/luatex.am +++ b/Build/source/texk/web2c/luatexdir/am/luatex.am @@ -25,7 +25,7 @@ luatex_LDADD = $(luatex_ldadd) $(LDADD) $(socketlibs) luatex_DEPENDENCIES = $(proglib) libluatex.a luatex_DEPENDENCIES += $(LIBPNG_DEPEND) $(ZLIB_DEPEND) $(XPDF_DEPEND) -luatex_DEPENDENCIES += $(OBSDCOMPAT_DEPEND) libmd5.a +luatex_DEPENDENCIES += $(OBSDCOMPAT_DEPEND) libmd5.a libmplib.a $(luatex_OBJECTS): libluatex.a libmplib.a diff --git a/Build/source/texk/web2c/luatexdir/mp/avl.c b/Build/source/texk/web2c/luatexdir/mp/avl.c deleted file mode 100644 index 703c4b2e72d..00000000000 --- a/Build/source/texk/web2c/luatexdir/mp/avl.c +++ /dev/null @@ -1,792 +0,0 @@ -/* Produced by texiweb from libavl.w on 2003/01/06 at 18:07. */ - -/* libavl - library for manipulation of binary trees. - Copyright (C) 1998-2002 Free Software Foundation, Inc. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License as - published by the Free Software Foundation; either version 2 of the - License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - See the GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA - 02111-1307, USA. - - The author may be contacted at <blp@gnu.org> on the Internet, or - write to Ben Pfaff, Stanford University, Computer Science Dept., 353 - Serra Mall, Stanford CA 94305, USA. -*/ - -#include <assert.h> -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include "avl.h" - -/* Creates and returns a new table - with comparison function |compare| using parameter |param| - and memory allocator |allocator|. - Returns |NULL| if memory allocation failed. */ -struct avl_table *avl_create (avl_comparison_func * compare, void *param, - struct libavl_allocator *allocator) -{ - struct avl_table *tree; - - assert (compare != NULL); - - if (allocator == NULL) - allocator = &avl_allocator_default; - - tree = allocator->libavl_malloc (allocator, sizeof *tree); - if (tree == NULL) - return NULL; - - tree->avl_root = NULL; - tree->avl_compare = compare; - tree->avl_param = param; - tree->avl_alloc = allocator; - tree->avl_count = 0; - tree->avl_generation = 0; - - return tree; -} - -/* Search |tree| for an item matching |item|, and return it if found. - Otherwise return |NULL|. */ -void *avl_find (const struct avl_table *tree, const void *item) -{ - const struct avl_node *p; - - assert (tree != NULL && item != NULL); - for (p = tree->avl_root; p != NULL;) { - int cmp = tree->avl_compare (item, p->avl_data, tree->avl_param); - - if (cmp < 0) - p = p->avl_link[0]; - else if (cmp > 0) - p = p->avl_link[1]; - else /* |cmp == 0| */ - return p->avl_data; - } - - return NULL; -} - -/* Inserts |item| into |tree| and returns a pointer to |item|'s address. - If a duplicate item is found in the tree, - returns a pointer to the duplicate without inserting |item|. - Returns |NULL| in case of memory allocation failure. */ -void **avl_probe (struct avl_table *tree, void *item) -{ - struct avl_node *y, *z; /* Top node to update balance factor, and parent. */ - struct avl_node *p, *q; /* Iterator, and parent. */ - struct avl_node *n; /* Newly inserted node. */ - struct avl_node *w; /* New root of rebalanced subtree. */ - int dir; /* Direction to descend. */ - - unsigned char da[AVL_MAX_HEIGHT]; /* Cached comparison results. */ - int k = 0; /* Number of cached results. */ - - assert (tree != NULL && item != NULL); - - z = (struct avl_node *) &tree->avl_root; - y = tree->avl_root; - dir = 0; - for (q = z, p = y; p != NULL; q = p, p = p->avl_link[dir]) { - int cmp = tree->avl_compare (item, p->avl_data, tree->avl_param); - if (cmp == 0) - return &p->avl_data; - - if (p->avl_balance != 0) - z = q, y = p, k = 0; - da[k++] = dir = cmp > 0; - } - - n = q->avl_link[dir] = - tree->avl_alloc->libavl_malloc (tree->avl_alloc, sizeof *n); - if (n == NULL) - return NULL; - - tree->avl_count++; - n->avl_data = item; - n->avl_link[0] = n->avl_link[1] = NULL; - n->avl_balance = 0; - if (y == NULL) - return &n->avl_data; - - for (p = y, k = 0; p != n; p = p->avl_link[da[k]], k++) - if (da[k] == 0) - p->avl_balance--; - else - p->avl_balance++; - - if (y->avl_balance == -2) { - struct avl_node *x = y->avl_link[0]; - if (x->avl_balance == -1) { - w = x; - y->avl_link[0] = x->avl_link[1]; - x->avl_link[1] = y; - x->avl_balance = y->avl_balance = 0; - } else { - assert (x->avl_balance == +1); - w = x->avl_link[1]; - x->avl_link[1] = w->avl_link[0]; - w->avl_link[0] = x; - y->avl_link[0] = w->avl_link[1]; - w->avl_link[1] = y; - if (w->avl_balance == -1) - x->avl_balance = 0, y->avl_balance = +1; - else if (w->avl_balance == 0) - x->avl_balance = y->avl_balance = 0; - else /* |w->avl_balance == +1| */ - x->avl_balance = -1, y->avl_balance = 0; - w->avl_balance = 0; - } - } else if (y->avl_balance == +2) { - struct avl_node *x = y->avl_link[1]; - if (x->avl_balance == +1) { - w = x; - y->avl_link[1] = x->avl_link[0]; - x->avl_link[0] = y; - x->avl_balance = y->avl_balance = 0; - } else { - assert (x->avl_balance == -1); - w = x->avl_link[0]; - x->avl_link[0] = w->avl_link[1]; - w->avl_link[1] = x; - y->avl_link[1] = w->avl_link[0]; - w->avl_link[0] = y; - if (w->avl_balance == +1) - x->avl_balance = 0, y->avl_balance = -1; - else if (w->avl_balance == 0) - x->avl_balance = y->avl_balance = 0; - else /* |w->avl_balance == -1| */ - x->avl_balance = +1, y->avl_balance = 0; - w->avl_balance = 0; - } - } else - return &n->avl_data; - z->avl_link[y != z->avl_link[0]] = w; - - tree->avl_generation++; - return &n->avl_data; -} - -/* Inserts |item| into |table|. - Returns |NULL| if |item| was successfully inserted - or if a memory allocation error occurred. - Otherwise, returns the duplicate item. */ -void *avl_insert (struct avl_table *table, void *item) -{ - void **p = avl_probe (table, item); - return p == NULL || *p == item ? NULL : *p; -} - -/* Inserts |item| into |table|, replacing any duplicate item. - Returns |NULL| if |item| was inserted without replacing a duplicate, - or if a memory allocation error occurred. - Otherwise, returns the item that was replaced. */ -void *avl_replace (struct avl_table *table, void *item) -{ - void **p = avl_probe (table, item); - if (p == NULL || *p == item) - return NULL; - else { - void *r = *p; - *p = item; - return r; - } -} - -/* Deletes from |tree| and returns an item matching |item|. - Returns a null pointer if no matching item found. */ -void *avl_delete (struct avl_table *tree, const void *item) -{ - /* Stack of nodes. */ - struct avl_node *pa[AVL_MAX_HEIGHT]; /* Nodes. */ - unsigned char da[AVL_MAX_HEIGHT]; /* |avl_link[]| indexes. */ - int k; /* Stack pointer. */ - - struct avl_node *p; /* Traverses tree to find node to delete. */ - int cmp; /* Result of comparison between |item| and |p|. */ - - assert (tree != NULL && item != NULL); - - k = 0; - p = (struct avl_node *) &tree->avl_root; - for (cmp = -1; cmp != 0; - cmp = tree->avl_compare (item, p->avl_data, tree->avl_param)) { - int dir = cmp > 0; - - pa[k] = p; - da[k++] = dir; - - p = p->avl_link[dir]; - if (p == NULL) - return NULL; - } - item = p->avl_data; - - if (p->avl_link[1] == NULL) - pa[k - 1]->avl_link[da[k - 1]] = p->avl_link[0]; - else { - struct avl_node *r = p->avl_link[1]; - if (r->avl_link[0] == NULL) { - r->avl_link[0] = p->avl_link[0]; - r->avl_balance = p->avl_balance; - pa[k - 1]->avl_link[da[k - 1]] = r; - da[k] = 1; - pa[k++] = r; - } else { - struct avl_node *s; - int j = k++; - - for (;;) { - da[k] = 0; - pa[k++] = r; - s = r->avl_link[0]; - if (s->avl_link[0] == NULL) - break; - - r = s; - } - - s->avl_link[0] = p->avl_link[0]; - r->avl_link[0] = s->avl_link[1]; - s->avl_link[1] = p->avl_link[1]; - s->avl_balance = p->avl_balance; - - pa[j - 1]->avl_link[da[j - 1]] = s; - da[j] = 1; - pa[j] = s; - } - } - - tree->avl_alloc->libavl_free (tree->avl_alloc, p); - - assert (k > 0); - while (--k > 0) { - struct avl_node *y = pa[k]; - - if (da[k] == 0) { - y->avl_balance++; - if (y->avl_balance == +1) - break; - else if (y->avl_balance == +2) { - struct avl_node *x = y->avl_link[1]; - if (x->avl_balance == -1) { - struct avl_node *w; - assert (x->avl_balance == -1); - w = x->avl_link[0]; - x->avl_link[0] = w->avl_link[1]; - w->avl_link[1] = x; - y->avl_link[1] = w->avl_link[0]; - w->avl_link[0] = y; - if (w->avl_balance == +1) - x->avl_balance = 0, y->avl_balance = -1; - else if (w->avl_balance == 0) - x->avl_balance = y->avl_balance = 0; - else /* |w->avl_balance == -1| */ - x->avl_balance = +1, y->avl_balance = 0; - w->avl_balance = 0; - pa[k - 1]->avl_link[da[k - 1]] = w; - } else { - y->avl_link[1] = x->avl_link[0]; - x->avl_link[0] = y; - pa[k - 1]->avl_link[da[k - 1]] = x; - if (x->avl_balance == 0) { - x->avl_balance = -1; - y->avl_balance = +1; - break; - } else - x->avl_balance = y->avl_balance = 0; - } - } - } else { - y->avl_balance--; - if (y->avl_balance == -1) - break; - else if (y->avl_balance == -2) { - struct avl_node *x = y->avl_link[0]; - if (x->avl_balance == +1) { - struct avl_node *w; - assert (x->avl_balance == +1); - w = x->avl_link[1]; - x->avl_link[1] = w->avl_link[0]; - w->avl_link[0] = x; - y->avl_link[0] = w->avl_link[1]; - w->avl_link[1] = y; - if (w->avl_balance == -1) - x->avl_balance = 0, y->avl_balance = +1; - else if (w->avl_balance == 0) - x->avl_balance = y->avl_balance = 0; - else /* |w->avl_balance == +1| */ - x->avl_balance = -1, y->avl_balance = 0; - w->avl_balance = 0; - pa[k - 1]->avl_link[da[k - 1]] = w; - } else { - y->avl_link[0] = x->avl_link[1]; - x->avl_link[1] = y; - pa[k - 1]->avl_link[da[k - 1]] = x; - if (x->avl_balance == 0) { - x->avl_balance = +1; - y->avl_balance = -1; - break; - } else - x->avl_balance = y->avl_balance = 0; - } - } - } - } - - tree->avl_count--; - tree->avl_generation++; - return (void *) item; -} - -/* Refreshes the stack of parent pointers in |trav| - and updates its generation number. */ -static void trav_refresh (struct avl_traverser *trav) -{ - assert (trav != NULL); - - trav->avl_generation = trav->avl_table->avl_generation; - - if (trav->avl_node != NULL) { - avl_comparison_func *cmp = trav->avl_table->avl_compare; - void *param = trav->avl_table->avl_param; - struct avl_node *node = trav->avl_node; - struct avl_node *i; - - trav->avl_height = 0; - for (i = trav->avl_table->avl_root; i != node;) { - assert (trav->avl_height < AVL_MAX_HEIGHT); - assert (i != NULL); - - trav->avl_stack[trav->avl_height++] = i; - i = i->avl_link[cmp (node->avl_data, i->avl_data, param) > 0]; - } - } -} - -/* Initializes |trav| for use with |tree| - and selects the null node. */ -void avl_t_init (struct avl_traverser *trav, struct avl_table *tree) -{ - trav->avl_table = tree; - trav->avl_node = NULL; - trav->avl_height = 0; - trav->avl_generation = tree->avl_generation; -} - -/* Initializes |trav| for |tree| - and selects and returns a pointer to its least-valued item. - Returns |NULL| if |tree| contains no nodes. */ -void *avl_t_first (struct avl_traverser *trav, struct avl_table *tree) -{ - struct avl_node *x; - - assert (tree != NULL && trav != NULL); - - trav->avl_table = tree; - trav->avl_height = 0; - trav->avl_generation = tree->avl_generation; - - x = tree->avl_root; - if (x != NULL) - while (x->avl_link[0] != NULL) { - assert (trav->avl_height < AVL_MAX_HEIGHT); - trav->avl_stack[trav->avl_height++] = x; - x = x->avl_link[0]; - } - trav->avl_node = x; - - return x != NULL ? x->avl_data : NULL; -} - -/* Initializes |trav| for |tree| - and selects and returns a pointer to its greatest-valued item. - Returns |NULL| if |tree| contains no nodes. */ -void *avl_t_last (struct avl_traverser *trav, struct avl_table *tree) -{ - struct avl_node *x; - - assert (tree != NULL && trav != NULL); - - trav->avl_table = tree; - trav->avl_height = 0; - trav->avl_generation = tree->avl_generation; - - x = tree->avl_root; - if (x != NULL) - while (x->avl_link[1] != NULL) { - assert (trav->avl_height < AVL_MAX_HEIGHT); - trav->avl_stack[trav->avl_height++] = x; - x = x->avl_link[1]; - } - trav->avl_node = x; - - return x != NULL ? x->avl_data : NULL; -} - -/* Searches for |item| in |tree|. - If found, initializes |trav| to the item found and returns the item - as well. - If there is no matching item, initializes |trav| to the null item - and returns |NULL|. */ -void *avl_t_find (struct avl_traverser *trav, struct avl_table *tree, - void *item) -{ - struct avl_node *p, *q; - - assert (trav != NULL && tree != NULL && item != NULL); - trav->avl_table = tree; - trav->avl_height = 0; - trav->avl_generation = tree->avl_generation; - for (p = tree->avl_root; p != NULL; p = q) { - int cmp = tree->avl_compare (item, p->avl_data, tree->avl_param); - - if (cmp < 0) - q = p->avl_link[0]; - else if (cmp > 0) - q = p->avl_link[1]; - else { /* |cmp == 0| */ - - trav->avl_node = p; - return p->avl_data; - } - - assert (trav->avl_height < AVL_MAX_HEIGHT); - trav->avl_stack[trav->avl_height++] = p; - } - - trav->avl_height = 0; - trav->avl_node = NULL; - return NULL; -} - -/* Attempts to insert |item| into |tree|. - If |item| is inserted successfully, it is returned and |trav| is - initialized to its location. - If a duplicate is found, it is returned and |trav| is initialized to - its location. No replacement of the item occurs. - If a memory allocation failure occurs, |NULL| is returned and |trav| - is initialized to the null item. */ -void *avl_t_insert (struct avl_traverser *trav, struct avl_table *tree, - void *item) -{ - void **p; - - assert (trav != NULL && tree != NULL && item != NULL); - - p = avl_probe (tree, item); - if (p != NULL) { - trav->avl_table = tree; - trav->avl_node = ((struct avl_node *) - ((char *) p - offsetof (struct avl_node, avl_data))); - trav->avl_generation = tree->avl_generation - 1; - return *p; - } else { - avl_t_init (trav, tree); - return NULL; - } -} - -/* Initializes |trav| to have the same current node as |src|. */ -void *avl_t_copy (struct avl_traverser *trav, const struct avl_traverser *src) -{ - assert (trav != NULL && src != NULL); - - if (trav != src) { - trav->avl_table = src->avl_table; - trav->avl_node = src->avl_node; - trav->avl_generation = src->avl_generation; - if (trav->avl_generation == trav->avl_table->avl_generation) { - trav->avl_height = src->avl_height; - memcpy (trav->avl_stack, (const void *) src->avl_stack, - sizeof *trav->avl_stack * trav->avl_height); - } - } - - return trav->avl_node != NULL ? trav->avl_node->avl_data : NULL; -} - -/* Returns the next data item in inorder - within the tree being traversed with |trav|, - or if there are no more data items returns |NULL|. */ -void *avl_t_next (struct avl_traverser *trav) -{ - struct avl_node *x; - - assert (trav != NULL); - - if (trav->avl_generation != trav->avl_table->avl_generation) - trav_refresh (trav); - - x = trav->avl_node; - if (x == NULL) { - return avl_t_first (trav, trav->avl_table); - } else if (x->avl_link[1] != NULL) { - assert (trav->avl_height < AVL_MAX_HEIGHT); - trav->avl_stack[trav->avl_height++] = x; - x = x->avl_link[1]; - - while (x->avl_link[0] != NULL) { - assert (trav->avl_height < AVL_MAX_HEIGHT); - trav->avl_stack[trav->avl_height++] = x; - x = x->avl_link[0]; - } - } else { - struct avl_node *y; - - do { - if (trav->avl_height == 0) { - trav->avl_node = NULL; - return NULL; - } - - y = x; - x = trav->avl_stack[--trav->avl_height]; - } - while (y == x->avl_link[1]); - } - trav->avl_node = x; - - return x->avl_data; -} - -/* Returns the previous data item in inorder - within the tree being traversed with |trav|, - or if there are no more data items returns |NULL|. */ -void *avl_t_prev (struct avl_traverser *trav) -{ - struct avl_node *x; - - assert (trav != NULL); - - if (trav->avl_generation != trav->avl_table->avl_generation) - trav_refresh (trav); - - x = trav->avl_node; - if (x == NULL) { - return avl_t_last (trav, trav->avl_table); - } else if (x->avl_link[0] != NULL) { - assert (trav->avl_height < AVL_MAX_HEIGHT); - trav->avl_stack[trav->avl_height++] = x; - x = x->avl_link[0]; - - while (x->avl_link[1] != NULL) { - assert (trav->avl_height < AVL_MAX_HEIGHT); - trav->avl_stack[trav->avl_height++] = x; - x = x->avl_link[1]; - } - } else { - struct avl_node *y; - - do { - if (trav->avl_height == 0) { - trav->avl_node = NULL; - return NULL; - } - - y = x; - x = trav->avl_stack[--trav->avl_height]; - } - while (y == x->avl_link[0]); - } - trav->avl_node = x; - - return x->avl_data; -} - -/* Returns |trav|'s current item. */ -void *avl_t_cur (struct avl_traverser *trav) -{ - assert (trav != NULL); - - return trav->avl_node != NULL ? trav->avl_node->avl_data : NULL; -} - -/* Replaces the current item in |trav| by |new| and returns the item replaced. - |trav| must not have the null item selected. - The new item must not upset the ordering of the tree. */ -void *avl_t_replace (struct avl_traverser *trav, void *new) -{ - void *old; - - assert (trav != NULL && trav->avl_node != NULL && new != NULL); - old = trav->avl_node->avl_data; - trav->avl_node->avl_data = new; - return old; -} - -static void -copy_error_recovery (struct avl_node **stack, int height, - struct avl_table *new, avl_item_func * destroy) -{ - assert (stack != NULL && height >= 0 && new != NULL); - - for (; height > 2; height -= 2) - stack[height - 1]->avl_link[1] = NULL; - avl_destroy (new, destroy); -} - -/* Copies |org| to a newly created tree, which is returned. - If |copy != NULL|, each data item in |org| is first passed to |copy|, - and the return values are inserted into the tree, - with |NULL| return values taken as indications of failure. - On failure, destroys the partially created new tree, - applying |destroy|, if non-null, to each item in the new tree so far, - and returns |NULL|. - If |allocator != NULL|, it is used for allocation in the new tree. - Otherwise, the same allocator used for |org| is used. */ -struct avl_table *avl_copy (const struct avl_table *org, avl_copy_func * copy, - avl_item_func * destroy, - struct libavl_allocator *allocator) -{ - struct avl_node *stack[2 * (AVL_MAX_HEIGHT + 1)]; - int height = 0; - - struct avl_table *new; - const struct avl_node *x; - struct avl_node *y; - - assert (org != NULL); - new = avl_create (org->avl_compare, org->avl_param, - allocator != NULL ? allocator : org->avl_alloc); - if (new == NULL) - return NULL; - new->avl_count = org->avl_count; - if (new->avl_count == 0) - return new; - - x = (const struct avl_node *) &org->avl_root; - y = (struct avl_node *) &new->avl_root; - for (;;) { - while (x->avl_link[0] != NULL) { - assert (height < 2 * (AVL_MAX_HEIGHT + 1)); - - y->avl_link[0] = - new->avl_alloc->libavl_malloc (new->avl_alloc, - sizeof *y->avl_link[0]); - if (y->avl_link[0] == NULL) { - if (y != (struct avl_node *) &new->avl_root) { - y->avl_data = NULL; - y->avl_link[1] = NULL; - } - - copy_error_recovery (stack, height, new, destroy); - return NULL; - } - - stack[height++] = (struct avl_node *) x; - stack[height++] = y; - x = x->avl_link[0]; - y = y->avl_link[0]; - } - y->avl_link[0] = NULL; - - for (;;) { - y->avl_balance = x->avl_balance; - if (copy == NULL) - y->avl_data = x->avl_data; - else { - y->avl_data = copy (x->avl_data, org->avl_param); - if (y->avl_data == NULL) { - y->avl_link[1] = NULL; - copy_error_recovery (stack, height, new, destroy); - return NULL; - } - } - - if (x->avl_link[1] != NULL) { - y->avl_link[1] = - new->avl_alloc->libavl_malloc (new->avl_alloc, - sizeof *y->avl_link[1]); - if (y->avl_link[1] == NULL) { - copy_error_recovery (stack, height, new, destroy); - return NULL; - } - - x = x->avl_link[1]; - y = y->avl_link[1]; - break; - } else - y->avl_link[1] = NULL; - - if (height <= 2) - return new; - - y = stack[--height]; - x = stack[--height]; - } - } -} - -/* Frees storage allocated for |tree|. - If |destroy != NULL|, applies it to each data item in inorder. */ -void avl_destroy (struct avl_table *tree, avl_item_func * destroy) -{ - struct avl_node *p, *q; - - assert (tree != NULL); - - for (p = tree->avl_root; p != NULL; p = q) - if (p->avl_link[0] == NULL) { - q = p->avl_link[1]; - if (destroy != NULL && p->avl_data != NULL) - destroy (p->avl_data, tree->avl_param); - tree->avl_alloc->libavl_free (tree->avl_alloc, p); - } else { - q = p->avl_link[0]; - p->avl_link[0] = q->avl_link[1]; - q->avl_link[1] = p; - } - - tree->avl_alloc->libavl_free (tree->avl_alloc, tree); -} - -/* Allocates |size| bytes of space using |malloc()|. - Returns a null pointer if allocation fails. */ -void *avl_malloc (struct libavl_allocator *allocator, size_t size) -{ - assert (allocator != NULL && size > 0); - return malloc (size); -} - -/* Frees |block|. */ -void avl_free (struct libavl_allocator *allocator, void *block) -{ - assert (allocator != NULL && block != NULL); - free (block); -} - -/* Default memory allocator that uses |malloc()| and |free()|. */ -struct libavl_allocator avl_allocator_default = { - avl_malloc, - avl_free -}; - -#undef NDEBUG -#include <assert.h> - -/* Asserts that |avl_insert()| succeeds at inserting |item| into |table|. */ -void - (avl_assert_insert) (struct avl_table * table, void *item) { - void **p = avl_probe (table, item); - assert (p != NULL && *p == item); -} - -/* Asserts that |avl_delete()| really removes |item| from |table|, - and returns the removed item. */ -void *(avl_assert_delete) (struct avl_table * table, void *item) { - void *p = avl_delete (table, item); - assert (p != NULL); - return p; -} diff --git a/Build/source/texk/web2c/luatexdir/mp/avl.h b/Build/source/texk/web2c/luatexdir/mp/avl.h deleted file mode 100644 index acdf8bacc53..00000000000 --- a/Build/source/texk/web2c/luatexdir/mp/avl.h +++ /dev/null @@ -1,118 +0,0 @@ -/* Produced by texiweb from libavl.w on 2003/01/06 at 18:07. */ - -/* libavl - library for manipulation of binary trees. - Copyright (C) 1998-2002 Free Software Foundation, Inc. - - This program is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License as - published by the Free Software Foundation; either version 2 of the - License, or (at your option) any later version. - - This program is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - See the GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA - 02111-1307, USA. - - The author may be contacted at <blp@gnu.org> on the Internet, or - write to Ben Pfaff, Stanford University, Computer Science Dept., 353 - Serra Mall, Stanford CA 94305, USA. -*/ - -#ifndef AVL_H -# define AVL_H 1 - -# include <stddef.h> -# if defined(__cplusplus) -extern "C" { -# endif - - -/* Function types. */ - typedef int avl_comparison_func (const void *avl_a, const void *avl_b, - void *avl_param); - typedef void avl_item_func (void *avl_item, void *avl_param); - typedef void *avl_copy_func (void *avl_item, void *avl_param); - -# ifndef LIBAVL_ALLOCATOR -# define LIBAVL_ALLOCATOR -/* Memory allocator. */ - struct libavl_allocator { - void *(*libavl_malloc) (struct libavl_allocator *, size_t libavl_size); - void (*libavl_free) (struct libavl_allocator *, void *libavl_block); - }; -# endif - -/* Default memory allocator. */ - extern struct libavl_allocator avl_allocator_default; - void *avl_malloc (struct libavl_allocator *, size_t); - void avl_free (struct libavl_allocator *, void *); - -/* Maximum AVL height. */ -# ifndef AVL_MAX_HEIGHT -# define AVL_MAX_HEIGHT 32 -# endif - -/* Tree data structure. */ - struct avl_table { - struct avl_node *avl_root; /* Tree's root. */ - avl_comparison_func *avl_compare; /* Comparison function. */ - void *avl_param; /* Extra argument to |avl_compare|. */ - struct libavl_allocator *avl_alloc; /* Memory allocator. */ - size_t avl_count; /* Number of items in tree. */ - unsigned long avl_generation; /* Generation number. */ - }; - -/* An AVL tree node. */ - struct avl_node { - struct avl_node *avl_link[2]; /* Subtrees. */ - void *avl_data; /* Pointer to data. */ - signed char avl_balance; /* Balance factor. */ - }; - -/* AVL traverser structure. */ - struct avl_traverser { - struct avl_table *avl_table; /* Tree being traversed. */ - struct avl_node *avl_node; /* Current node in tree. */ - struct avl_node *avl_stack[AVL_MAX_HEIGHT]; - /* All the nodes above |avl_node|. */ - size_t avl_height; /* Number of nodes in |avl_parent|. */ - unsigned long avl_generation; /* Generation number. */ - }; - -/* Table functions. */ - struct avl_table *avl_create (avl_comparison_func *, void *, - struct libavl_allocator *); - struct avl_table *avl_copy (const struct avl_table *, avl_copy_func *, - avl_item_func *, struct libavl_allocator *); - void avl_destroy (struct avl_table *, avl_item_func *); - void **avl_probe (struct avl_table *, void *); - void *avl_insert (struct avl_table *, void *); - void *avl_replace (struct avl_table *, void *); - void *avl_delete (struct avl_table *, const void *); - void *avl_find (const struct avl_table *, const void *); - void avl_assert_insert (struct avl_table *, void *); - void *avl_assert_delete (struct avl_table *, void *); - -# define avl_count(table) ((size_t) (table)->avl_count) - -/* Table traverser functions. */ - void avl_t_init (struct avl_traverser *, struct avl_table *); - void *avl_t_first (struct avl_traverser *, struct avl_table *); - void *avl_t_last (struct avl_traverser *, struct avl_table *); - void *avl_t_find (struct avl_traverser *, struct avl_table *, void *); - void *avl_t_insert (struct avl_traverser *, struct avl_table *, void *); - void *avl_t_copy (struct avl_traverser *, const struct avl_traverser *); - void *avl_t_next (struct avl_traverser *); - void *avl_t_prev (struct avl_traverser *); - void *avl_t_cur (struct avl_traverser *); - void *avl_t_replace (struct avl_traverser *, void *); - -# if defined(__cplusplus) -} -# endif -#endif /* avl.h */ diff --git a/Build/source/texk/web2c/luatexdir/mp/lmplib.c b/Build/source/texk/web2c/luatexdir/mp/lmplib.c deleted file mode 100644 index 7bea10e1406..00000000000 --- a/Build/source/texk/web2c/luatexdir/mp/lmplib.c +++ /dev/null @@ -1,1238 +0,0 @@ -/* lmplib.c - - Copyright 2006-2008 Taco Hoekwater <taco@luatex.org> - - This file is part of LuaTeX. - - LuaTeX is free software; you can redistribute it and/or modify it under - the terms of the GNU General Public License as published by the Free - Software Foundation; either version 2 of the License, or (at your - option) any later version. - - LuaTeX is distributed in the hope that it will be useful, but WITHOUT - ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or - FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public - License for more details. - - You should have received a copy of the GNU General Public License along - with LuaTeX; if not, see <http://www.gnu.org/licenses/>. */ - -#include "config.h" -#include <stdlib.h> -#include <string.h> -#include <unistd.h> -#include <math.h> /* temporary */ - -#ifndef pdfTeX -# include <lua.h> -# include <lauxlib.h> -# include <lualib.h> -#else -# include <../lua51/lua.h> -# include <../lua51/lauxlib.h> -# include <../lua51/lualib.h> -#endif - -#include "mplib.h" -#include "mplibps.h" - - /*@unused@*/ static const char _svn_version[] = - "$Id: lmplib.c 1364 2008-07-04 16:09:46Z taco $ $URL: http://scm.foundry.supelec.fr/svn/luatex/trunk/src/texk/web2c/luatexdir/lua/lmplib.c $"; - -/* metatable identifiers and tests */ - -#define MPLIB_METATABLE "MPlib" -#define MPLIB_FIG_METATABLE "MPlib.fig" -#define MPLIB_GR_METATABLE "MPlib.gr" - -#define is_mp(L,b) (MP *)luaL_checkudata(L,b,MPLIB_METATABLE) -#define is_fig(L,b) (struct mp_edge_object **)luaL_checkudata(L,b,MPLIB_FIG_METATABLE) -#define is_gr_object(L,b) (struct mp_graphic_object **)luaL_checkudata(L,b,MPLIB_GR_METATABLE) - -/* Lua string pre-hashing */ - -#define mplib_init_S(a) do { \ - lua_pushliteral(L,#a); \ - mplib_##a##_ptr = (char *)lua_tostring(L,-1); \ - mplib_##a##_index = luaL_ref (L,LUA_REGISTRYINDEX); \ - } while (0) - -#define mplib_push_S(a) do { \ - lua_rawgeti(L,LUA_REGISTRYINDEX,mplib_##a##_index); \ - } while (0) - -#define mplib_is_S(a,i) (mplib_##a##_ptr==(char *)lua_tostring(L,i)) - -#define mplib_make_S(a) \ - static int mplib_##a##_index = 0; \ - static char *mplib_##a##_ptr = NULL - -static int mplib_type_Ses[mp_special_code + 1] = { 0 }; /* [0] is not used */ - -mplib_make_S(fill); -mplib_make_S(outline); -mplib_make_S(text); -mplib_make_S(special); -mplib_make_S(start_bounds); -mplib_make_S(stop_bounds); -mplib_make_S(start_clip); -mplib_make_S(stop_clip); - -mplib_make_S(left_type); -mplib_make_S(right_type); -mplib_make_S(x_coord); -mplib_make_S(y_coord); -mplib_make_S(left_x); -mplib_make_S(left_y); -mplib_make_S(right_x); -mplib_make_S(right_y); - -mplib_make_S(color); -mplib_make_S(dash); -mplib_make_S(depth); -mplib_make_S(dsize); -mplib_make_S(font); -mplib_make_S(height); -mplib_make_S(htap); -mplib_make_S(linecap); -mplib_make_S(linejoin); -mplib_make_S(miterlimit); -mplib_make_S(path); -mplib_make_S(pen); -mplib_make_S(postscript); -mplib_make_S(prescript); -mplib_make_S(transform); -mplib_make_S(type); -mplib_make_S(width); - -static void mplib_init_Ses(lua_State * L) -{ - mplib_init_S(fill); - mplib_init_S(outline); - mplib_init_S(text); - mplib_init_S(start_bounds); - mplib_init_S(stop_bounds); - mplib_init_S(start_clip); - mplib_init_S(stop_clip); - mplib_init_S(special); - - mplib_type_Ses[mp_fill_code] = mplib_fill_index; - mplib_type_Ses[mp_stroked_code] = mplib_outline_index; - mplib_type_Ses[mp_text_code] = mplib_text_index; - mplib_type_Ses[mp_start_bounds_code] = mplib_start_bounds_index; - mplib_type_Ses[mp_stop_bounds_code] = mplib_stop_bounds_index; - mplib_type_Ses[mp_start_clip_code] = mplib_start_clip_index; - mplib_type_Ses[mp_stop_clip_code] = mplib_stop_clip_index; - mplib_type_Ses[mp_special_code] = mplib_special_index; - - mplib_init_S(left_type); - mplib_init_S(right_type); - mplib_init_S(x_coord); - mplib_init_S(y_coord); - mplib_init_S(left_x); - mplib_init_S(left_y); - mplib_init_S(right_x); - mplib_init_S(right_y); - - mplib_init_S(color); - mplib_init_S(dash); - mplib_init_S(depth); - mplib_init_S(dsize); - mplib_init_S(font); - mplib_init_S(height); - mplib_init_S(htap); - mplib_init_S(linecap); - mplib_init_S(linejoin); - mplib_init_S(miterlimit); - mplib_init_S(path); - mplib_init_S(pen); - mplib_init_S(postscript); - mplib_init_S(prescript); - mplib_init_S(transform); - mplib_init_S(type); - mplib_init_S(width); -} - - -/* Enumeration arrays to map MPlib enums to Lua strings */ - -static const char *interaction_options[] = - { "unknown", "batch", "nonstop", "scroll", "errorstop", NULL }; - -static const char *mplib_filetype_names[] = - { "term", "error", "mp", "log", "ps", "mem", "tfm", "map", "pfb", "enc", NULL }; - -static const char *knot_type_enum[] = - { "endpoint", "explicit", "given", "curl", "open", "end_cycle" }; - -static const char *fill_fields[] = - { "type", "path", "htap", "pen", "color", "linejoin", "miterlimit", - "prescript", "postscript", NULL }; - -static const char *stroked_fields[] = - { "type", "path", "pen", "color", "linejoin", "miterlimit", "linecap", - "dash", "prescript", "postscript", NULL }; - -static const char *text_fields[] = - { "type", "text", "dsize", "font", "color", "width", "height", "depth", - "transform", "prescript", "postscript", NULL }; - -static const char *special_fields[] = - { "type", "prescript", NULL }; - -static const char *start_bounds_fields[] = - { "type", "path", NULL }; - -static const char *start_clip_fields[] = - { "type", "path", NULL }; - -static const char *stop_bounds_fields[] = - { "type", NULL }; - -static const char *stop_clip_fields[] = - { "type", NULL }; - -static const char *no_fields[] = - { NULL }; - - -/* The list of supported MPlib options (not all make sense) */ - -typedef enum { - P_ERROR_LINE, P_MAX_LINE, - P_MAIN_MEMORY, P_HASH_SIZE, P_PARAM_SIZE, P_IN_OPEN, P_RANDOM_SEED, - P_INTERACTION, P_INI_VERSION, P_MEM_NAME, P_JOB_NAME, P_FIND_FILE, - P__SENTINEL } mplib_parm_idx; - -typedef struct { - const char *name; /* parameter name */ - mplib_parm_idx idx; /* parameter index */ -} mplib_parm_struct; - -static mplib_parm_struct mplib_parms[] = { - {"error_line", P_ERROR_LINE }, - {"print_line", P_MAX_LINE }, - {"main_memory", P_MAIN_MEMORY }, - {"hash_size", P_HASH_SIZE }, - {"param_size", P_PARAM_SIZE }, - {"max_in_open", P_IN_OPEN }, - {"random_seed", P_RANDOM_SEED }, - {"interaction", P_INTERACTION }, - {"ini_version", P_INI_VERSION }, - {"mem_name", P_MEM_NAME }, - {"job_name", P_JOB_NAME }, - {"find_file", P_FIND_FILE }, - {NULL, P__SENTINEL } -}; - - -/* Start by defining the needed callback routines for the library */ - -static char *mplib_find_file(MP mp, const char *fname, const char *fmode, int ftype) -{ - lua_State *L = (lua_State *)mp_userdata(mp); - lua_checkstack(L, 4); - lua_getfield(L, LUA_REGISTRYINDEX, "mplib_file_finder"); - if (lua_isfunction(L, -1)) { - char *s = NULL, *x = NULL; - lua_pushstring(L, fname); - lua_pushstring(L, fmode); - if (ftype >= mp_filetype_text) { - lua_pushnumber(L, (lua_Number)(ftype - mp_filetype_text)); - } else { - lua_pushstring(L, mplib_filetype_names[ftype]); - } - if (lua_pcall(L, 3, 1, 0) != 0) { - fprintf(stdout, "Error in mp.find_file: %s\n", - (char *) lua_tostring(L, -1)); - return NULL; - } - x = (char *) lua_tostring(L, -1); - if (x != NULL) - s = strdup(x); - lua_pop(L, 1); /* pop the string */ - return s; - } else { - lua_pop(L, 1); - } - if (fmode[0] != 'r' || (!access(fname, R_OK)) || ftype) { - return strdup(fname); - } - return NULL; -} - -static int mplib_find_file_function(lua_State * L) -{ - if (!(lua_isfunction(L, -1) || lua_isnil(L, -1))) { - return 1; /* error */ - } - lua_pushstring(L, "mplib_file_finder"); - lua_pushvalue(L, -2); - lua_rawset(L, LUA_REGISTRYINDEX); - return 0; -} - -#define xfree(A) if ((A)!=NULL) { free((A)); A = NULL; } - -static int mplib_new(lua_State * L) -{ - MP *mp_ptr; - mp_ptr = lua_newuserdata(L, sizeof(MP *)); - if (mp_ptr) { - int i; - struct MP_options *options = mp_options(); - options->userdata = (void *) L; - options->noninteractive = 1; /* required ! */ - options->find_file = mplib_find_file; - options->print_found_names = 1; - if (lua_type(L, 1) == LUA_TTABLE) { - for (i = 0; mplib_parms[i].name != NULL; i++) { - lua_getfield(L, 1, mplib_parms[i].name); - if (lua_isnil(L, -1)) { - lua_pop(L, 1); - continue; /* skip unset */ - } - switch (mplib_parms[i].idx) { - case P_ERROR_LINE: - options->error_line = (int)lua_tointeger(L, -1); - if (options->error_line<60) options->error_line =60; - if (options->error_line>250) options->error_line = 250; - options->half_error_line = (options->error_line/2)+10; - break; - case P_MAX_LINE: - options->max_print_line = (int)lua_tointeger(L, -1); - if (options->max_print_line<60) options->max_print_line = 60; - break; - case P_MAIN_MEMORY: - options->main_memory = (int)lua_tointeger(L, -1); - break; - case P_HASH_SIZE: - options->hash_size = (unsigned)lua_tointeger(L, -1); - break; - case P_PARAM_SIZE: - options->param_size = (int)lua_tointeger(L, -1); - break; - case P_IN_OPEN: - options->max_in_open = (int)lua_tointeger(L, -1); - break; - case P_RANDOM_SEED: - options->random_seed = (int)lua_tointeger(L, -1); - break; - case P_INTERACTION: - options->interaction = - luaL_checkoption(L, -1, "errorstopmode", - interaction_options); - break; - case P_INI_VERSION: - options->ini_version = lua_toboolean(L, -1); - break; - case P_MEM_NAME: - options->mem_name = strdup((char *) lua_tostring(L, -1)); - break; - case P_JOB_NAME: - options->job_name = strdup((char *) lua_tostring(L, -1)); - break; - case P_FIND_FILE: - if (mplib_find_file_function(L)) { /* error here */ - fprintf(stdout, - "Invalid arguments to mp.new({find_file=...})\n"); - } - break; - default: - break; - } - lua_pop(L, 1); - } - } - *mp_ptr = mp_initialize(options); - xfree(options->command_line); - xfree(options->mem_name); - free(options); - if (*mp_ptr) { - luaL_getmetatable(L, MPLIB_METATABLE); - lua_setmetatable(L, -2); - return 1; - } - } - lua_pushnil(L); - return 1; -} - -static int mplib_collect(lua_State * L) -{ - MP *mp_ptr = is_mp(L, 1); - if (*mp_ptr != NULL) { - (void)mp_finish(*mp_ptr); - *mp_ptr = NULL; - } - return 0; -} - -static int mplib_tostring(lua_State * L) -{ - MP *mp_ptr = is_mp(L, 1); - if (*mp_ptr != NULL) { - (void)lua_pushfstring(L, "<MP %p>", *mp_ptr); - return 1; - } - return 0; -} - -static int mplib_wrapresults(lua_State * L, mp_run_data *res, int status) -{ - lua_checkstack(L, 5); - lua_newtable(L); - if (res->term_out.size != 0) { - lua_pushstring(L, res->term_out.data); - lua_setfield(L, -2, "term"); - } - if (res->error_out.size != 0) { - lua_pushstring(L, res->error_out.data); - lua_setfield(L, -2, "error"); - } - if (res->log_out.size != 0) { - lua_pushstring(L, res->log_out.data); - lua_setfield(L, -2, "log"); - } - if (res->edges != NULL) { - struct mp_edge_object **v; - struct mp_edge_object *p = res->edges; - int i = 1; - lua_newtable(L); - while (p != NULL) { - v = lua_newuserdata(L, sizeof(struct mp_edge_object *)); - *v = p; - luaL_getmetatable(L, MPLIB_FIG_METATABLE); - lua_setmetatable(L, -2); - lua_rawseti(L, -2, i); - i++; - p = p->next; - } - lua_setfield(L, -2, "fig"); - res->edges = NULL; - } - lua_pushnumber(L, (lua_Number)status); - lua_setfield(L, -2, "status"); - return 1; -} - -static int mplib_execute(lua_State * L) -{ - MP *mp_ptr = is_mp(L, 1); - if (*mp_ptr != NULL && lua_isstring(L, 2)) { - size_t l; - char *s = (char *) lua_tolstring(L, 2, &l); - int h = mp_execute(*mp_ptr, s, l); - mp_run_data *res = mp_rundata(*mp_ptr); - return mplib_wrapresults(L, res, h); - } else { - lua_pushnil(L); - } - return 1; -} - -static int mplib_finish(lua_State * L) -{ - MP *mp_ptr = is_mp(L, 1); - if (*mp_ptr != NULL) { - int i; - int h = mp_execute(*mp_ptr,NULL,0); - mp_run_data *res = mp_rundata(*mp_ptr); - i = mplib_wrapresults(L, res, h); - (void)mp_finish(*mp_ptr); - *mp_ptr = NULL; - return i; - } else { - lua_pushnil(L); - } - return 1; -} - -static int mplib_char_dimension(lua_State * L, int t) -{ - MP *mp_ptr = is_mp(L, 1); - if (*mp_ptr != NULL) { - char *fname = (char *)luaL_checkstring(L,2); - int charnum = (int)luaL_checkinteger(L,3); - if (charnum<0 || charnum>255) { - lua_pushnumber(L, (lua_Number)0); - } else { - lua_pushnumber(L,(lua_Number)mp_get_char_dimension(*mp_ptr,fname,charnum,t)); - } - } else { - lua_pushnumber(L, (lua_Number)0); - } - return 1; -} - -static int mplib_charwidth(lua_State * L) -{ - return mplib_char_dimension(L, 'w'); -} - -static int mplib_chardepth(lua_State * L) -{ - return mplib_char_dimension(L, 'd'); -} - -static int mplib_charheight(lua_State * L) -{ - return mplib_char_dimension(L, 'h'); -} - -static int mplib_version(lua_State * L) -{ - char *s = mp_metapost_version(); - lua_pushstring(L, s); - free(s); - return 1; -} - -static int mplib_statistics(lua_State * L) -{ - MP *mp_ptr = is_mp(L, 1); - if (*mp_ptr != NULL) { - lua_newtable(L); - lua_pushnumber(L, (lua_Number)mp_memory_usage(*mp_ptr)); - lua_setfield(L, -2, "main_memory"); - lua_pushnumber(L, (lua_Number)mp_hash_usage(*mp_ptr)); - lua_setfield(L, -2, "hash_size"); - lua_pushnumber(L, (lua_Number)mp_param_usage(*mp_ptr)); - lua_setfield(L, -2, "param_size"); - lua_pushnumber(L, (lua_Number)mp_open_usage(*mp_ptr)); - lua_setfield(L, -2, "max_in_open"); - } else { - lua_pushnil(L); - } - return 1; -} - - -/* figure methods */ - -static int mplib_fig_collect(lua_State * L) -{ - struct mp_edge_object **hh = is_fig(L, 1); - if (*hh != NULL) { - mp_gr_toss_objects(*hh); - *hh = NULL; - } - return 0; -} - -static int mplib_fig_body(lua_State * L) -{ - int i = 1; - struct mp_graphic_object **v; - struct mp_graphic_object *p; - struct mp_edge_object **hh = is_fig(L, 1); - lua_newtable(L); - p = (*hh)->body; - while (p != NULL) { - v = lua_newuserdata(L, sizeof(struct mp_graphic_object *)); - *v = p; - luaL_getmetatable(L, MPLIB_GR_METATABLE); - lua_setmetatable(L, -2); - lua_rawseti(L, -2, i); - i++; - p = p->next; - } - (*hh)->body = NULL; /* prevent double free */ - return 1; -} - -static int mplib_fig_copy_body(lua_State * L) -{ - int i = 1; - struct mp_graphic_object **v; - struct mp_graphic_object *p; - struct mp_edge_object **hh = is_fig(L, 1); - lua_newtable(L); - p = (*hh)->body; - while (p != NULL) { - v = lua_newuserdata(L, sizeof(struct mp_graphic_object *)); - *v = mp_gr_copy_object((*hh)->parent, p); - luaL_getmetatable(L, MPLIB_GR_METATABLE); - lua_setmetatable(L, -2); - lua_rawseti(L, -2, i); - i++; - p = p->next; - } - return 1; -} - - -static int mplib_fig_tostring(lua_State * L) -{ - struct mp_edge_object **hh = is_fig(L, 1); - (void)lua_pushfstring(L, "<figure %p>", *hh); - return 1; -} - -static int mplib_fig_postscript(lua_State * L) -{ - mp_run_data *res; - struct mp_edge_object **hh = is_fig(L, 1); - int prologues = (int)luaL_optnumber(L, 2, (lua_Number)-1); - int procset = (int)luaL_optnumber(L, 3, (lua_Number)-1); - if (mp_ps_ship_out(*hh, prologues, procset) - && (res = mp_rundata((*hh)->parent)) - && (res->ps_out.size != 0)) { - lua_pushstring(L, res->ps_out.data); - } else { - lua_pushnil(L); - } - return 1; -} - -static int mplib_fig_filename(lua_State * L) -{ - struct mp_edge_object **hh = is_fig(L, 1); - if (*hh != NULL) { - char *s = (*hh)->filename; - lua_pushstring(L, s); - } else { - lua_pushnil(L); - } - return 1; -} - -static int mplib_fig_width(lua_State * L) -{ - struct mp_edge_object **hh = is_fig(L, 1); - if (*hh != NULL) { - lua_pushnumber(L, (double) (*hh)->width / 65536.0); - } else { - lua_pushnil(L); - } - return 1; -} - -static int mplib_fig_height(lua_State * L) -{ - struct mp_edge_object **hh = is_fig(L, 1); - if (*hh != NULL) { - lua_pushnumber(L, (double) (*hh)->height / 65536.0); - } else { - lua_pushnil(L); - } - return 1; -} - -static int mplib_fig_depth(lua_State * L) -{ - struct mp_edge_object **hh = is_fig(L, 1); - if (*hh != NULL) { - lua_pushnumber(L, (double) (*hh)->depth / 65536.0); - } else { - lua_pushnil(L); - } - return 1; -} - -static int mplib_fig_italcorr(lua_State * L) -{ - struct mp_edge_object **hh = is_fig(L, 1); - if (*hh != NULL) { - lua_pushnumber(L, (double) (*hh)->ital_corr / 65536.0); - } else { - lua_pushnil(L); - } - return 1; -} - -static int mplib_fig_charcode(lua_State * L) -{ - struct mp_edge_object **hh = is_fig(L, 1); - if (*hh != NULL) { - lua_pushnumber(L, (lua_Number)(*hh)->charcode); - } else { - lua_pushnil(L); - } - return 1; -} - - - -static int mplib_fig_bb(lua_State * L) -{ - struct mp_edge_object **hh = is_fig(L, 1); - lua_newtable(L); - lua_pushnumber(L, (double) (*hh)->minx / 65536.0); - lua_rawseti(L, -2, 1); - lua_pushnumber(L, (double) (*hh)->miny / 65536.0); - lua_rawseti(L, -2, 2); - lua_pushnumber(L, (double) (*hh)->maxx / 65536.0); - lua_rawseti(L, -2, 3); - lua_pushnumber(L, (double) (*hh)->maxy / 65536.0); - lua_rawseti(L, -2, 4); - return 1; -} - -/* object methods */ - -static int mplib_gr_collect(lua_State * L) -{ - struct mp_graphic_object **hh = is_gr_object(L, 1); - if (*hh != NULL) { - mp_gr_toss_object(*hh); - *hh = NULL; - } - return 0; -} - -static int mplib_gr_tostring(lua_State * L) -{ - struct mp_graphic_object **hh = is_gr_object(L, 1); - (void)lua_pushfstring(L, "<object %p>", *hh); - return 1; -} - -#define pyth(a,b) (sqrt((a)*(a) + (b)*(b))) - -#define aspect_bound (10.0/65536.0) -#define aspect_default (1.0/65536.0) - -static double eps = 0.0001; - -static double coord_range_x (mp_knot *h, double dz) { - double z; - double zlo = 0.0, zhi = 0.0; - mp_knot *f = h; - while (h != NULL) { - z = (double)h->x_coord; - if (z < zlo) zlo = z; else if (z > zhi) zhi = z; - z = (double)h->right_x; - if (z < zlo) zlo = z; else if (z > zhi) zhi = z; - z = (double)h->left_x; - if (z < zlo) zlo = z; else if (z > zhi) zhi = z; - h = h->next; - if (h==f) - break; - } - return (zhi - zlo <= dz ? aspect_bound : aspect_default); -} - -static double coord_range_y (mp_knot *h, double dz) { - double z; - double zlo = 0.0, zhi = 0.0; - mp_knot *f = h; - while (h != NULL) { - z = (double)h->y_coord; - if (z < zlo) zlo = z; else if (z > zhi) zhi = z; - z = (double)h->right_y; - if (z < zlo) zlo = z; else if (z > zhi) zhi = z; - z = (double)h->left_y; - if (z < zlo) zlo = z; else if (z > zhi) zhi = z; - h = h->next; - if (h==f) - break; - } - return (zhi - zlo <= dz ? aspect_bound : aspect_default); -} - - -static int mplib_gr_peninfo(lua_State * L) { - double x_coord, y_coord, left_x, left_y, right_x, right_y; - double wx, wy; - double rx = 1.0, sx = 0.0, sy = 0.0, ry = 1.0, tx = 0.0, ty = 0.0; - double divider = 1.0; - double width = 1.0; - mp_knot *p = NULL, *path = NULL; - struct mp_graphic_object **hh = is_gr_object(L, -1); - if (!*hh) { - lua_pushnil(L); - return 1; - } - if ((*hh)->type == mp_fill_code) { - p = ((mp_fill_object *)(*hh))->pen_p; - path = ((mp_fill_object *)(*hh))->path_p; - } else if ((*hh)->type == mp_stroked_code) { - p = ((mp_stroked_object *)(*hh))->pen_p; - path = ((mp_stroked_object *)(*hh))->path_p; - } - if (p==NULL || path == NULL) { - lua_pushnil(L); - return 1; - } - x_coord = p->x_coord/65536.0; - y_coord = p->y_coord/65536.0; - left_x = p->left_x/65536.0; - left_y = p->left_y/65536.0; - right_x = p->right_x/65536.0; - right_y = p->right_y/65536.0; - if ((right_x == x_coord) && (left_y == y_coord)) { - wx = fabs(left_x - x_coord); - wy = fabs(right_y - y_coord); - } else { - wx = pyth(left_x - x_coord, right_x - x_coord); - wy = pyth(left_y - y_coord, right_y - y_coord); - } - if ((wy/coord_range_x(path, wx)) >= (wx/coord_range_y(path, wy))) - width = wy; - else - width = wx; - tx = x_coord; - ty = y_coord; - sx = left_x - tx; - rx = left_y - ty; - ry = right_x - tx; - sy = right_y - ty; - if (width !=1.0) { - if (width == 0.0) { - sx = 1.0; sy = 1.0; - } else { - rx/=width; ry/=width; sx/=width; sy/=width; - } - } - if (fabs(sx) < eps) sx = eps; - if (fabs(sy) < eps) sy = eps; - divider = sx*sy - rx*ry; - lua_newtable(L); - lua_pushnumber(L,width); lua_setfield(L,-2,"width"); - lua_pushnumber(L,rx); lua_setfield(L,-2,"rx"); - lua_pushnumber(L,sx); lua_setfield(L,-2,"sx"); - lua_pushnumber(L,sy); lua_setfield(L,-2,"sy"); - lua_pushnumber(L,ry); lua_setfield(L,-2,"ry"); - lua_pushnumber(L,tx); lua_setfield(L,-2,"tx"); - lua_pushnumber(L,ty); lua_setfield(L,-2,"ty"); - return 1; -} - - -static int mplib_gr_fields(lua_State * L) -{ - const char **fields; - int i; - struct mp_graphic_object **hh = is_gr_object(L, 1); - if (*hh) { - switch ((*hh)->type) { - case mp_fill_code: - fields = fill_fields; - break; - case mp_stroked_code: - fields = stroked_fields; - break; - case mp_text_code: - fields = text_fields; - break; - case mp_special_code: - fields = special_fields; - break; - case mp_start_clip_code: - fields = start_clip_fields; - break; - case mp_start_bounds_code: - fields = start_bounds_fields; - break; - case mp_stop_clip_code: - fields = stop_clip_fields; - break; - case mp_stop_bounds_code: - fields = stop_bounds_fields; - break; - default: - fields = no_fields; - } - lua_newtable(L); - for (i = 0; fields[i] != NULL; i++) { - lua_pushstring(L, fields[i]); - lua_rawseti(L, -2, (i + 1)); - } - } else { - lua_pushnil(L); - } - return 1; -} - - -#define mplib_push_number(L,x) lua_pushnumber(L,(lua_Number)(x)/65536.0) - -#define MPLIB_PATH 0 -#define MPLIB_PEN 1 - -static void mplib_push_path(lua_State * L, struct mp_knot *h, int is_pen) -{ - struct mp_knot *p; /* for scanning the path */ - int i = 1; - p = h; - if (p != NULL) { - lua_newtable(L); - do { - lua_createtable(L, 0, 6); - if (!is_pen) { - if (p->left_type != mp_explicit) { - mplib_push_S(left_type); - lua_pushstring(L, knot_type_enum[p->left_type]); - lua_rawset(L, -3); - } - if (p->right_type != mp_explicit) { - mplib_push_S(right_type); - lua_pushstring(L, knot_type_enum[p->right_type]); - lua_rawset(L, -3); - } - } - mplib_push_S(x_coord); - mplib_push_number(L, p->x_coord); - lua_rawset(L, -3); - mplib_push_S(y_coord); - mplib_push_number(L, p->y_coord); - lua_rawset(L, -3); - mplib_push_S(left_x); - mplib_push_number(L, p->left_x); - lua_rawset(L, -3); - mplib_push_S(left_y); - mplib_push_number(L, p->left_y); - lua_rawset(L, -3); - mplib_push_S(right_x); - mplib_push_number(L, p->right_x); - lua_rawset(L, -3); - mplib_push_S(right_y); - mplib_push_number(L, p->right_y); - lua_rawset(L, -3); - lua_rawseti(L, -2, i); - i++; - if (p->right_type == mp_endpoint) { - return; - } - p = p->next; - } while (p != h); - } else { - lua_pushnil(L); - } -} - -/* this assumes that the top of the stack is a table - or nil already in the case - */ -static void mplib_push_pentype(lua_State * L, struct mp_knot *h) -{ - struct mp_knot *p; /* for scanning the path */ - p = h; - if (p == NULL) { - /* do nothing */ - } else if (p == p->next) { - mplib_push_S(type); - lua_pushstring(L, "elliptical"); - lua_rawset(L, -3); - } else { - } -} - -#define set_color_objects(pq) \ - object_color_model = pq->color_model; \ - object_color_a = pq->color.a_val; \ - object_color_b = pq->color.b_val; \ - object_color_c = pq->color.c_val; \ - object_color_d = pq->color.d_val; - - -static void mplib_push_color(lua_State * L, struct mp_graphic_object *p) -{ - int object_color_model; - int object_color_a, object_color_b, object_color_c, object_color_d; - if (p != NULL) { - if (p->type == mp_fill_code) { - mp_fill_object *h = (mp_fill_object *) p; - set_color_objects(h); - } else if (p->type == mp_stroked_code) { - mp_stroked_object *h = (mp_stroked_object *) p; - set_color_objects(h); - } else { - mp_text_object *h = (mp_text_object *) p; - set_color_objects(h); - } - lua_newtable(L); - if (object_color_model >= mp_grey_model) { - mplib_push_number(L, object_color_a); - lua_rawseti(L, -2, 1); - if (object_color_model >= mp_rgb_model) { - mplib_push_number(L, object_color_b); - lua_rawseti(L, -2, 2); - mplib_push_number(L, object_color_c); - lua_rawseti(L, -2, 3); - if (object_color_model == mp_cmyk_model) { - mplib_push_number(L, object_color_d); - lua_rawseti(L, -2, 4); - } - } - } - } else { - lua_pushnil(L); - } -} - -/* the dash scale is not exported, the field has no external value */ -static void mplib_push_dash(lua_State * L, struct mp_stroked_object *h) -{ - mp_dash_object *d; - double ds; - if (h != NULL && h->dash_p != NULL) { - d = h->dash_p; - lua_newtable(L); - mplib_push_number(L, d->offset); - lua_setfield(L, -2, "offset"); - if (d->array != NULL) { - int i = 0; - lua_newtable(L); - while (*(d->array + i) != -1) { - ds = *(d->array + i) / 65536.0; - lua_pushnumber(L, ds); - i++; - lua_rawseti(L, -2, i); - } - lua_setfield(L, -2, "dashes"); - } - } else { - lua_pushnil(L); - } -} - -static void mplib_push_transform(lua_State * L, struct mp_text_object *h) -{ - int i = 1; - if (h != NULL) { - lua_createtable(L, 6, 0); - mplib_push_number(L, h->tx); - lua_rawseti(L, -2, i); - i++; - mplib_push_number(L, h->ty); - lua_rawseti(L, -2, i); - i++; - mplib_push_number(L, h->txx); - lua_rawseti(L, -2, i); - i++; - mplib_push_number(L, h->tyx); - lua_rawseti(L, -2, i); - i++; - mplib_push_number(L, h->txy); - lua_rawseti(L, -2, i); - i++; - mplib_push_number(L, h->tyy); - lua_rawseti(L, -2, i); - i++; - } else { - lua_pushnil(L); - } -} - -#define FIELD(A) (mplib_is_S(A,2)) - -static void mplib_fill(lua_State * L, struct mp_fill_object *h) -{ - if (FIELD(path)) { - mplib_push_path(L, h->path_p, MPLIB_PATH); - } else if (FIELD(htap)) { - mplib_push_path(L, h->htap_p, MPLIB_PATH); - } else if (FIELD(pen)) { - mplib_push_path(L, h->pen_p, MPLIB_PEN); - mplib_push_pentype(L, h->pen_p); - } else if (FIELD(color)) { - mplib_push_color(L, (mp_graphic_object *) h); - } else if (FIELD(linejoin)) { - lua_pushnumber(L, (lua_Number)h->ljoin); - } else if (FIELD(miterlimit)) { - mplib_push_number(L, h->miterlim); - } else if (FIELD(prescript)) { - lua_pushstring(L, h->pre_script); - } else if (FIELD(postscript)) { - lua_pushstring(L, h->post_script); - } else { - lua_pushnil(L); - } -} - -static void mplib_stroked(lua_State * L, struct mp_stroked_object *h) -{ - if (FIELD(path)) { - mplib_push_path(L, h->path_p, MPLIB_PATH); - } else if (FIELD(pen)) { - mplib_push_path(L, h->pen_p, MPLIB_PEN); - mplib_push_pentype(L, h->pen_p); - } else if (FIELD(color)) { - mplib_push_color(L, (mp_graphic_object *) h); - } else if (FIELD(dash)) { - mplib_push_dash(L, h); - } else if (FIELD(linecap)) { - lua_pushnumber(L, (lua_Number)h->lcap); - } else if (FIELD(linejoin)) { - lua_pushnumber(L, (lua_Number)h->ljoin); - } else if (FIELD(miterlimit)) { - mplib_push_number(L, h->miterlim); - } else if (FIELD(prescript)) { - lua_pushstring(L, h->pre_script); - } else if (FIELD(postscript)) { - lua_pushstring(L, h->post_script); - } else { - lua_pushnil(L); - } -} - -static void mplib_text(lua_State * L, struct mp_text_object *h) -{ - if (FIELD(text)) { - lua_pushstring(L, h->text_p); - } else if (FIELD(dsize)) { - mplib_push_number(L, (h->font_dsize / 16)); - } else if (FIELD(font)) { - lua_pushstring(L, h->font_name); - } else if (FIELD(color)) { - mplib_push_color(L, (mp_graphic_object *) h); - } else if (FIELD(width)) { - mplib_push_number(L, h->width); - } else if (FIELD(height)) { - mplib_push_number(L, h->height); - } else if (FIELD(depth)) { - mplib_push_number(L, h->depth); - } else if (FIELD(transform)) { - mplib_push_transform(L, h); - } else if (FIELD(prescript)) { - lua_pushstring(L, h->pre_script); - } else if (FIELD(postscript)) { - lua_pushstring(L, h->post_script); - } else { - lua_pushnil(L); - } -} - -static void mplib_special(lua_State * L, struct mp_special_object *h) -{ - if (FIELD(prescript)) { - lua_pushstring(L, h->pre_script); - } else { - lua_pushnil(L); - } -} - -static void mplib_start_bounds(lua_State * L, struct mp_bounds_object *h) -{ - if (FIELD(path)) { - mplib_push_path(L, h->path_p, MPLIB_PATH); - } else { - lua_pushnil(L); - } -} - -static void mplib_start_clip(lua_State * L, struct mp_clip_object *h) -{ - if (FIELD(path)) { - mplib_push_path(L, h->path_p, MPLIB_PATH); - } else { - lua_pushnil(L); - } -} - -static int mplib_gr_index(lua_State * L) -{ - struct mp_graphic_object **hh = is_gr_object(L, 1); - if (*hh) { - struct mp_graphic_object *h = *hh; - - if (mplib_is_S(type, 2)) { - lua_rawgeti(L, LUA_REGISTRYINDEX, mplib_type_Ses[h->type]); - } else { - switch (h->type) { - case mp_fill_code: - mplib_fill(L, (mp_fill_object *) h); - break; - case mp_stroked_code: - mplib_stroked(L, (mp_stroked_object *) h); - break; - case mp_text_code: - mplib_text(L, (mp_text_object *) h); - break; - case mp_special_code: - mplib_special(L, (mp_special_object *) h); - break; - case mp_start_clip_code: - mplib_start_clip(L, (mp_clip_object *) h); - break; - case mp_start_bounds_code: - mplib_start_bounds(L, (mp_bounds_object *) h); - break; - case mp_stop_clip_code: - case mp_stop_bounds_code: - default: - lua_pushnil(L); - } - } - } else { - lua_pushnil(L); - } - return 1; -} - - -static const struct luaL_reg mplib_meta[] = { - {"__gc", mplib_collect}, - {"__tostring", mplib_tostring}, - {NULL, NULL} /* sentinel */ -}; - -static const struct luaL_reg mplib_fig_meta[] = { - {"__gc", mplib_fig_collect}, - {"__tostring", mplib_fig_tostring}, - {"objects", mplib_fig_body}, - {"copy_objects", mplib_fig_copy_body}, - {"filename", mplib_fig_filename}, - {"postscript", mplib_fig_postscript}, - {"boundingbox", mplib_fig_bb}, - {"width", mplib_fig_width}, - {"height", mplib_fig_height}, - {"depth", mplib_fig_depth}, - {"italcorr", mplib_fig_italcorr}, - {"charcode", mplib_fig_charcode}, - {NULL, NULL} /* sentinel */ -}; - -static const struct luaL_reg mplib_gr_meta[] = { - {"__gc", mplib_gr_collect}, - {"__tostring", mplib_gr_tostring}, - {"__index", mplib_gr_index}, - {NULL, NULL} /* sentinel */ -}; - -static const struct luaL_reg mplib_d[] = { - {"execute", mplib_execute}, - {"finish", mplib_finish}, - {"char_width", mplib_charwidth}, - {"char_height", mplib_charheight}, - {"char_depth", mplib_chardepth}, - {"statistics", mplib_statistics}, - {NULL, NULL} /* sentinel */ -}; - - -static const struct luaL_reg mplib_m[] = { - {"new", mplib_new}, - {"version", mplib_version}, - {"fields", mplib_gr_fields}, - {"pen_info", mplib_gr_peninfo}, - {NULL, NULL} /* sentinel */ -}; - - -int luaopen_mplib(lua_State * L) -{ - mplib_init_Ses(L); - - luaL_newmetatable(L, MPLIB_GR_METATABLE); - lua_pushvalue(L, -1); /* push metatable */ - lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */ - luaL_register(L, NULL, mplib_gr_meta); /* object meta methods */ - lua_pop(L, 1); - - luaL_newmetatable(L, MPLIB_FIG_METATABLE); - lua_pushvalue(L, -1); /* push metatable */ - lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */ - luaL_register(L, NULL, mplib_fig_meta); /* figure meta methods */ - lua_pop(L, 1); - - luaL_newmetatable(L, MPLIB_METATABLE); - lua_pushvalue(L, -1); /* push metatable */ - lua_setfield(L, -2, "__index"); /* metatable.__index = metatable */ - luaL_register(L, NULL, mplib_meta); /* meta methods */ - luaL_register(L, NULL, mplib_d); /* dict methods */ - luaL_register(L, "mplib", mplib_m); /* module functions */ - return 1; -} diff --git a/Build/source/texk/web2c/luatexdir/mp/memio.w b/Build/source/texk/web2c/luatexdir/mp/memio.w deleted file mode 100644 index 06bf9bf91d4..00000000000 --- a/Build/source/texk/web2c/luatexdir/mp/memio.w +++ /dev/null @@ -1,405 +0,0 @@ -% $Id: psout.w 616 2008-07-09 14:05:55Z taco $ -% -% Copyright 2008 Taco Hoekwater. -% -% This program is free software: you can redistribute it and/or modify -% it under the terms of the GNU General Public License as published by -% the Free Software Foundation, either version 2 of the License, or -% (at your option) any later version. -% -% This program is distributed in the hope that it will be useful, -% but WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -% GNU General Public License for more details. -% -% You should have received a copy of the GNU General Public License -% along with this program. If not, see <http://www.gnu.org/licenses/>. -% -% TeX is a trademark of the American Mathematical Society. -% METAFONT is a trademark of Addison-Wesley Publishing Company. -% PostScript is a trademark of Adobe Systems Incorporated. - -% Here is TeX material that gets inserted after \input webmac - -\font\tenlogo=logo10 % font used for the METAFONT logo -\def\MP{{\tenlogo META}\-{\tenlogo POST}} -\def\title{MetaPost MEM reading and writing} -\def\topofcontents{\hsize 5.5in - \vglue -30pt plus 1fil minus 1.5in - \def\?##1]{\hbox to 1in{\hfil##1.\ }} - } -\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in} -\pdfoutput=1 -\pageno=3 - -@ As usual, need true and false. - -@d true 1 -@d false 0 -@d null 0 /* the null pointer */ -@d incr(A) (A)=(A)+1 /* increase a variable by unity */ -@d decr(A) (A)=(A)-1 /* decrease a variable by unity */ -@d qo(A) (A) /* to read eight bits from a quarterword */ -@d qi(A) (quarterword)(A) /* to store eight bits in a quarterword */ -@d max_quarterword 0x3FFF /* largest allowable value in a |quarterword| */ -@d max_halfword 0xFFFFFFF /* largest allowable value in a |halfword| */ -@d max_str_ref 127 /* ``infinite'' number of references */ - - -@c -#include "config.h" -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include "mplib.h" -#include "mpmp.h" - -@ @c void mp_store_mem_file (MP mp) { - integer k; /* all-purpose index */ - pointer p,q; /* all-purpose pointers */ - integer x; /* something to dump */ - four_quarters w; /* four ASCII codes */ - memory_word WW; - @<Create the |mem_ident|, open the mem file, - and inform the user that dumping has begun@>; - @<Dump constants for consistency check@>; - @<Dump the string pool@>; - @<Dump the dynamic memory@>; - @<Dump the table of equivalents and the hash table@>; - @<Dump a few more things and the closing check word@>; - @<Close the mem file@>; -} - -@ Corresponding to the procedure that dumps a mem file, we also have a function -that reads~one~in. The function returns |false| if the dumped mem is -incompatible with the present \MP\ table sizes, etc. - -@d too_small(A) { wake_up_terminal; - wterm_ln("---! Must increase the "); wterm((A)); -@.Must increase the x@> - goto OFF_BASE; - } - -@c -boolean mp_load_mem_file (MP mp) { - integer k; /* all-purpose index */ - pointer p,q; /* all-purpose pointers */ - integer x; /* something undumped */ - str_number s; /* some temporary string */ - four_quarters w; /* four ASCII codes */ - memory_word WW; - @<Undump the string pool@>; - @<Undump the dynamic memory@>; - @<Undump the table of equivalents and the hash table@>; - @<Undump a few more things and the closing check word@>; - return true; /* it worked! */ -OFF_BASE: - wake_up_terminal; - wterm_ln("(Fatal mem file error; I'm stymied)\n"); -@.Fatal mem file error@> - return false; -} - -@ Mem files consist of |memory_word| items, and we use the following -macros to dump words of different types: - -@d dump_wd(A) { WW=(A); (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); } -@d dump_int(A) { int cint=(A); (mp->write_binary_file)(mp,mp->mem_file,&cint,sizeof(cint)); } -@d dump_hh(A) { WW.hh=(A); (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); } -@d dump_qqqq(A) { WW.qqqq=(A); (mp->write_binary_file)(mp,mp->mem_file,&WW,sizeof(WW)); } -@d dump_string(A) { dump_int((int)(strlen(A)+1)); - (mp->write_binary_file)(mp,mp->mem_file,A,strlen(A)+1); } - -@ The inverse macros are slightly more complicated, since we need to check -the range of the values we are reading in. We say `|undump(a)(b)(x)|' to -read an integer value |x| that is supposed to be in the range |a<=x<=b|. - -@d mgeti(A) do { - size_t wanted = sizeof(A); - void *A_ptr = &A; - (mp->read_binary_file)(mp, mp->mem_file,&A_ptr,&wanted); - if (wanted!=sizeof(A)) goto OFF_BASE; -} while (0) - -@d mgetw(A) do { - size_t wanted = sizeof(A); - void *A_ptr = &A; - (mp->read_binary_file)(mp, mp->mem_file,&A_ptr,&wanted); - if (wanted!=sizeof(A)) goto OFF_BASE; -} while (0) - -@d undump_wd(A) { mgetw(WW); A=WW; } -@d undump_int(A) { int cint; mgeti(cint); A=cint; } -@d undump_hh(A) { mgetw(WW); A=WW.hh; } -@d undump_qqqq(A) { mgetw(WW); A=WW.qqqq; } -@d undump_strings(A,B,C) { - undump_int(x); if ( (x<(A)) || (x>(B)) ) goto OFF_BASE; else C=str(x); } -@d undump(A,B,C) { undump_int(x); - if ( (x<(A)) || (x>(int)(B)) ) goto OFF_BASE; else C=x; } -@d undump_size(A,B,C,D) { undump_int(x); - if (x<(A)) goto OFF_BASE; - if (x>(B)) too_small((C)); else D=x; } -@d undump_string(A) { - size_t the_wanted; - void *the_string; - integer XX=0; - undump_int(XX); - the_wanted = (size_t)XX; - the_string = mp_xmalloc(mp,(size_t)XX,1); - (mp->read_binary_file)(mp,mp->mem_file,&the_string,&the_wanted); - A = (char *)the_string; - if (the_wanted!=(size_t)XX) goto OFF_BASE; -} - -@ The next few sections of the program should make it clear how we use the -dump/undump macros. - -@<Dump constants for consistency check@>= -x = metapost_magic; dump_int(x); -dump_int(mp->mem_top); -dump_int((integer)mp->hash_size); -dump_int(mp->hash_prime) -dump_int(mp->param_size); -dump_int(mp->max_in_open); - -@ Sections of a \.{WEB} program that are ``commented out'' still contribute -strings to the string pool; therefore \.{INIMP} and \MP\ will have -the same strings. (And it is, of course, a good thing that they do.) -@.WEB@> -@^string pool@> - -@ @c -int mp_undump_constants (MP mp) { - integer x; - undump_int(x); - if (x!=metapost_magic) return x; - undump_int(x); mp->mem_top = x; - undump_int(x); mp->hash_size = (unsigned)x; - undump_int(x); mp->hash_prime = x; - undump_int(x); mp->param_size = x; - undump_int(x); mp->max_in_open = x; - return metapost_magic; - OFF_BASE: - return -1; -} - -@ We do string pool compaction to avoid dumping unused strings. - -@d dump_four_ASCII - w.b0=qi(mp->str_pool[k]); w.b1=qi(mp->str_pool[k+1]); - w.b2=qi(mp->str_pool[k+2]); w.b3=qi(mp->str_pool[k+3]); - dump_qqqq(w) - -@<Dump the string pool@>= -mp_do_compaction(mp, mp->pool_size); -dump_int(mp->pool_ptr); -dump_int(mp->max_str_ptr); -dump_int(mp->str_ptr); -k=0; -while ( (mp->next_str[k]==k+1) && (k<=mp->max_str_ptr) ) - k++; -dump_int(k); -while ( k<=mp->max_str_ptr ) { - dump_int(mp->next_str[k]); incr(k); -} -k=0; -while (1) { - dump_int(mp->str_start[k]); /* TODO: valgrind warning here */ - if ( k==mp->str_ptr ) { - break; - } else { - k=mp->next_str[k]; - } -} -k=0; -while (k+4<mp->pool_ptr ) { - dump_four_ASCII; k=k+4; -} -k=mp->pool_ptr-4; dump_four_ASCII; -mp_print_ln(mp); mp_print(mp, "at most "); mp_print_int(mp, mp->max_str_ptr); -mp_print(mp, " strings of total length "); -mp_print_int(mp, mp->pool_ptr) - -@ @d undump_four_ASCII - undump_qqqq(w); - mp->str_pool[k]=(ASCII_code)qo(w.b0); mp->str_pool[k+1]=(ASCII_code)qo(w.b1); - mp->str_pool[k+2]=(ASCII_code)qo(w.b2); mp->str_pool[k+3]=(ASCII_code)qo(w.b3) - -@<Undump the string pool@>= -undump_int(mp->pool_ptr); -mp_reallocate_pool(mp, mp->pool_ptr) ; -undump_int(mp->max_str_ptr); -mp_reallocate_strings (mp,mp->max_str_ptr) ; -undump(0,mp->max_str_ptr,mp->str_ptr); -undump(0,mp->max_str_ptr+1,s); -for (k=0;k<=s-1;k++) - mp->next_str[k]=k+1; -for (k=s;k<=mp->max_str_ptr;k++) - undump(s+1,mp->max_str_ptr+1,mp->next_str[k]); -mp->fixed_str_use=0; -k=0; -while (1) { - undump(0,mp->pool_ptr,mp->str_start[k]); - if ( k==mp->str_ptr ) break; - mp->str_ref[k]=max_str_ref; - incr(mp->fixed_str_use); - mp->last_fixed_str=k; k=mp->next_str[k]; -} -k=0; -while ( k+4<mp->pool_ptr ) { - undump_four_ASCII; k=k+4; -} -k=mp->pool_ptr-4; undump_four_ASCII; -mp->init_str_use=mp->fixed_str_use; mp->init_pool_ptr=mp->pool_ptr; -mp->max_pool_ptr=mp->pool_ptr; -mp->strs_used_up=mp->fixed_str_use; -mp->pool_in_use=mp->str_start[mp->str_ptr]; mp->strs_in_use=mp->fixed_str_use; -mp->max_pl_used=mp->pool_in_use; mp->max_strs_used=mp->strs_in_use; -mp->pact_count=0; mp->pact_chars=0; mp->pact_strs=0; - -@ By sorting the list of available spaces in the variable-size portion of -|mem|, we are usually able to get by without having to dump very much -of the dynamic memory. - -We recompute |var_used| and |dyn_used|, so that \.{INIMP} dumps valid -information even when it has not been gathering statistics. - -@<Dump the dynamic memory@>= -mp_sort_avail(mp); mp->var_used=0; -dump_int(mp->lo_mem_max); dump_int(mp->rover); -p=0; q=mp->rover; x=0; -do { - for (k=p;k<= q+1;k++) - dump_wd(mp->mem[k]); - x=x+q+2-p; mp->var_used=mp->var_used+q-p; - p=q+node_size(q); q=rmp_link(q); -} while (q!=mp->rover); -mp->var_used=mp->var_used+mp->lo_mem_max-p; -mp->dyn_used=mp->mem_end+1-mp->hi_mem_min; -for (k=p;k<= mp->lo_mem_max;k++ ) - dump_wd(mp->mem[k]); -x=x+mp->lo_mem_max+1-p; -dump_int(mp->hi_mem_min); dump_int(mp->avail); -for (k=mp->hi_mem_min;k<=mp->mem_end;k++ ) - dump_wd(mp->mem[k]); -x=x+mp->mem_end+1-mp->hi_mem_min; -p=mp->avail; -while ( p!=null ) { - decr(mp->dyn_used); p=mp_link(p); -} -dump_int(mp->var_used); dump_int(mp->dyn_used); -mp_print_ln(mp); mp_print_int(mp, x); -mp_print(mp, " memory locations dumped; current usage is "); -mp_print_int(mp, mp->var_used); mp_print_char(mp, xord('&')); mp_print_int(mp, mp->dyn_used) - -@ @<Undump the dynamic memory@>= -undump(lo_mem_stat_max+1000,hi_mem_stat_min-1,mp->lo_mem_max); -undump(lo_mem_stat_max+1,mp->lo_mem_max,mp->rover); -p=0; q=mp->rover; -do { - for (k=p;k<= q+1; k++) - undump_wd(mp->mem[k]); - p=q+node_size(q); - if ( (p>mp->lo_mem_max)||((q>=rmp_link(q))&&(rmp_link(q)!=mp->rover)) ) - goto OFF_BASE; - q=rmp_link(q); -} while (q!=mp->rover); -for (k=p;k<=mp->lo_mem_max;k++ ) - undump_wd(mp->mem[k]); -undump(mp->lo_mem_max+1,hi_mem_stat_min,mp->hi_mem_min); -undump(null,mp->mem_top,mp->avail); mp->mem_end=mp->mem_top; -mp->last_pending=spec_head; -for (k=mp->hi_mem_min;k<= mp->mem_end;k++) - undump_wd(mp->mem[k]); -undump_int(mp->var_used); undump_int(mp->dyn_used) - -@ A different scheme is used to compress the hash table, since its lower region -is usually sparse. When |text(p)<>0| for |p<=hash_used|, we output three -words: |p|, |hash[p]|, and |eqtb[p]|. The hash table is, of course, densely -packed for |p>=hash_used|, so the remaining entries are output in~a~block. - -@<Dump the table of equivalents and the hash table@>= -dump_int(mp->hash_used); -mp->st_count=frozen_inaccessible-1-mp->hash_used; -for (p=1;p<=mp->hash_used;p++) { - if ( text(p)!=0 ) { - dump_int(p); dump_hh(mp->hash[p]); dump_hh(mp->eqtb[p]); incr(mp->st_count); - } -} -for (p=mp->hash_used+1;p<=(int)hash_end;p++) { - dump_hh(mp->hash[p]); dump_hh(mp->eqtb[p]); -} -dump_int(mp->st_count); -mp_print_ln(mp); mp_print_int(mp, mp->st_count); mp_print(mp, " symbolic tokens") - -@ @<Undump the table of equivalents and the hash table@>= -undump(1,frozen_inaccessible,mp->hash_used); -p=0; -do { - undump(p+1,mp->hash_used,p); - undump_hh(mp->hash[p]); undump_hh(mp->eqtb[p]); -} while (p!=mp->hash_used); -for (p=mp->hash_used+1;p<=(int)hash_end;p++ ) { - undump_hh(mp->hash[p]); undump_hh(mp->eqtb[p]); -} -undump_int(mp->st_count) - -@ We have already printed a lot of statistics, so we set |mp_tracing_stats:=0| -to prevent them appearing again. - -@<Dump a few more things and the closing check word@>= -dump_int(mp->max_internal); -dump_int(mp->int_ptr); -for (k=1;k<= mp->int_ptr;k++ ) { - dump_int(mp->internal[k]); - dump_string(mp->int_name[k]); -} -dump_int(mp->start_sym); -dump_int(mp->interaction); -dump_string(mp->mem_ident); -dump_int(mp->bg_loc); dump_int(mp->eg_loc); dump_int(mp->serial_no); dump_int(69073); -mp->internal[mp_tracing_stats]=0 - -@ @<Undump a few more things and the closing check word@>= -undump_int(x); -if (x>mp->max_internal) mp_grow_internals(mp,x); -undump_int(mp->int_ptr); -for (k=1;k<= mp->int_ptr;k++) { - undump_int(mp->internal[k]); - undump_string(mp->int_name[k]); -} -undump(0,frozen_inaccessible,mp->start_sym); -if (mp->interaction==mp_unspecified_mode) { - undump(mp_unspecified_mode,mp_error_stop_mode,mp->interaction); -} else { - undump(mp_unspecified_mode,mp_error_stop_mode,x); -} -undump_string(mp->mem_ident); -undump(1,hash_end,mp->bg_loc); -undump(1,hash_end,mp->eg_loc); -undump_int(mp->serial_no); -undump_int(x); -if (x!=69073) goto OFF_BASE - -@ @<Create the |mem_ident|...@>= -{ - char *tmp = mp_xmalloc(mp,11,1); - mp_xfree(mp->mem_ident); - mp->mem_ident = mp_xmalloc(mp,256,1); - mp_snprintf(tmp,11,"%04d.%02d.%02d", - (int)mp_round_unscaled(mp, mp->internal[mp_year]), - (int)mp_round_unscaled(mp, mp->internal[mp_month]), - (int)mp_round_unscaled(mp, mp->internal[mp_day])); - mp_snprintf(mp->mem_ident,256," (mem=%s %s)",mp->job_name, tmp); - mp_xfree(tmp); - mp_pack_job_name(mp, ".mem"); - while (! mp_w_open_out(mp, &mp->mem_file) ) - mp_prompt_file_name(mp, "mem file name", ".mem"); - mp_print_nl(mp, "Beginning to dump on file "); -@.Beginning to dump...@> - mp_print(mp, mp->name_of_file); - mp_print_nl(mp, mp->mem_ident); -} - -@ @<Close the mem file@>= -(mp->close_file)(mp,mp->mem_file) diff --git a/Build/source/texk/web2c/luatexdir/mp/mp.w b/Build/source/texk/web2c/luatexdir/mp/mp.w deleted file mode 100644 index ef61a38f820..00000000000 --- a/Build/source/texk/web2c/luatexdir/mp/mp.w +++ /dev/null @@ -1,26390 +0,0 @@ -% $Id: mp.w 806 2008-12-23 16:22:29Z taco $ -% -% Copyright 2008 Taco Hoekwater. -% -% This program is free software: you can redistribute it and/or modify -% it under the terms of the GNU General Public License as published by -% the Free Software Foundation, either version 2 of the License, or -% (at your option) any later version. -% -% This program is distributed in the hope that it will be useful, -% but WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -% GNU General Public License for more details. -% -% You should have received a copy of the GNU General Public License -% along with this program. If not, see <http://www.gnu.org/licenses/>. -% -% TeX is a trademark of the American Mathematical Society. -% METAFONT is a trademark of Addison-Wesley Publishing Company. -% PostScript is a trademark of Adobe Systems Incorporated. - -% Here is TeX material that gets inserted after \input webmac -\def\hang{\hangindent 3em\noindent\ignorespaces} -\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces} -\def\ps{PostScript} -\def\psqrt#1{\sqrt{\mathstrut#1}} -\def\k{_{k+1}} -\def\pct!{{\char`\%}} % percent sign in ordinary text -\font\tenlogo=logo10 % font used for the METAFONT logo -\font\logos=logosl10 -\def\MF{{\tenlogo META}\-{\tenlogo FONT}} -\def\MP{{\tenlogo META}\-{\tenlogo POST}} -\def\[#1]{\ignorespaces} % left over from pascal web -\def\<#1>{$\langle#1\rangle$} -\def\section{\mathhexbox278} -\let\swap=\leftrightarrow -\def\round{\mathop{\rm round}\nolimits} -\mathchardef\vbv="026A % synonym for `\|' -\def\vb{\relax\ifmmode\vbv\else$\vbv$\fi} - -\def\(#1){} % this is used to make section names sort themselves better -\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@> -\def\title{MetaPost} -\pdfoutput=1 -\pageno=3 - -@* \[1] Introduction. - -This is \MP\ by John Hobby, a graphics-language processor based on D. E. Knuth's \MF. - -Much of the original Pascal version of this program was copied with -permission from MF.web Version 1.9. It interprets a language very -similar to D.E. Knuth's METAFONT, but with changes designed to make it -more suitable for PostScript output. - -The main purpose of the following program is to explain the algorithms of \MP\ -as clearly as possible. However, the program has been written so that it -can be tuned to run efficiently in a wide variety of operating environments -by making comparatively few changes. Such flexibility is possible because -the documentation that follows is written in the \.{WEB} language, which is -at a higher level than C. - -A large piece of software like \MP\ has inherent complexity that cannot -be reduced below a certain level of difficulty, although each individual -part is fairly simple by itself. The \.{WEB} language is intended to make -the algorithms as readable as possible, by reflecting the way the -individual program pieces fit together and by providing the -cross-references that connect different parts. Detailed comments about -what is going on, and about why things were done in certain ways, have -been liberally sprinkled throughout the program. These comments explain -features of the implementation, but they rarely attempt to explain the -\MP\ language itself, since the reader is supposed to be familiar with -{\sl The {\logos METAFONT\/}book} as well as the manual -@.WEB@> -@:METAFONTbook}{\sl The {\logos METAFONT\/}book@> -{\sl A User's Manual for MetaPost}, Computing Science Technical Report 162, -AT\AM T Bell Laboratories. - -@ The present implementation is a preliminary version, but the possibilities -for new features are limited by the desire to remain as nearly compatible -with \MF\ as possible. - -On the other hand, the \.{WEB} description can be extended without changing -the core of the program, and it has been designed so that such -extensions are not extremely difficult to make. -The |banner| string defined here should be changed whenever \MP\ -undergoes any modifications, so that it will be clear which version of -\MP\ might be the guilty party when a problem arises. -@^extensions to \MP@> -@^system dependencies@> - -@d default_banner "This is MetaPost, Version 1.102" /* printed when \MP\ starts */ -@d true 1 -@d false 0 - -@(mpmp.h@>= -#define metapost_version "1.102" -#define metapost_magic (('M'*256) + 'P')*65536 + 1102 -#define metapost_old_magic (('M'*256) + 'P')*65536 + 1080 - -@ The external library header for \MP\ is |mplib.h|. It contains a -few typedefs and the header defintions for the externally used -fuctions. - -The most important of the typedefs is the definition of the structure -|MP_options|, that acts as a small, configurable front-end to the fairly -large |MP_instance| structure. - -@(mplib.h@>= -typedef struct MP_instance * MP; -@<Exported types@> -typedef struct MP_options { - @<Option variables@> -} MP_options; -@<Exported function headers@> - -@ The internal header file is much longer: it not only lists the complete -|MP_instance|, but also a lot of functions that have to be available to -the \ps\ backend, that is defined in a separate \.{WEB} file. - -The variables from |MP_options| are included inside the |MP_instance| -wholesale. - -@(mpmp.h@>= -#include <setjmp.h> -typedef struct psout_data_struct * psout_data; -#ifndef HAVE_BOOLEAN -typedef int boolean; -#endif -#ifndef INTEGER_TYPE -typedef int integer; -#endif -@<Declare helpers@> -@<Types in the outer block@> -@<Constants in the outer block@> -# ifndef LIBAVL_ALLOCATOR -# define LIBAVL_ALLOCATOR - struct libavl_allocator { - void *(*libavl_malloc) (struct libavl_allocator *, size_t libavl_size); - void (*libavl_free) (struct libavl_allocator *, void *libavl_block); - }; -# endif -typedef struct MP_instance { - @<Option variables@> - @<Global variables@> -} MP_instance; -@<Internal library declarations@> - -@ @c -#include "config.h" -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <stdarg.h> -#include <assert.h> -#ifdef HAVE_UNISTD_H -#include <unistd.h> /* for access() */ -#endif -#include <time.h> /* for struct tm \& co */ -#include "mplib.h" -#include "mplibps.h" /* external header */ -#include "mpmp.h" /* internal header */ -#include "mppsout.h" /* internal header */ -extern font_number mp_read_font_info (MP mp, char *fname); /* tfmin.w */ -@h -@<Declarations@> -@<Basic printing procedures@> -@<Error handling procedures@> - -@ Here are the functions that set up the \MP\ instance. - -@<Declarations@> = -MP_options *mp_options (void); -MP mp_initialize (MP_options *opt); - -@ @c -MP_options *mp_options (void) { - MP_options *opt; - size_t l = sizeof(MP_options); - opt = malloc(l); - if (opt!=NULL) { - memset (opt,0,l); - opt->ini_version = true; - } - return opt; -} - -@ @<Internal library declarations@>= -@<Declare subroutines for parsing file names@> - -@ The whole instance structure is initialized with zeroes, -this greatly reduces the number of statements needed in -the |Allocate or initialize variables| block. - -@d set_callback_option(A) do { mp->A = mp_##A; - if (opt->A!=NULL) mp->A = opt->A; -} while (0) - -@c -static MP mp_do_new (jmp_buf *buf) { - MP mp = malloc(sizeof(MP_instance)); - if (mp==NULL) { - xfree(buf); - return NULL; - } - memset(mp,0,sizeof(MP_instance)); - mp->jump_buf = buf; - return mp; -} - -@ @c -static void mp_free (MP mp) { - int k; /* loop variable */ - @<Dealloc variables@> - if (mp->noninteractive) { - @<Finish non-interactive use@>; - } - xfree(mp->jump_buf); - xfree(mp); -} - -@ @c -static void mp_do_initialize ( MP mp) { - @<Local variables for initialization@> - @<Set initial values of key variables@> -} - -@ This procedure gets things started properly. -@c -MP mp_initialize (MP_options *opt) { - MP mp; - jmp_buf *buf = malloc(sizeof(jmp_buf)); - if (buf == NULL || setjmp(*buf) != 0) - return NULL; - mp = mp_do_new(buf); - if (mp == NULL) - return NULL; - mp->userdata=opt->userdata; - @<Set |ini_version|@>; - mp->noninteractive=opt->noninteractive; - set_callback_option(find_file); - set_callback_option(open_file); - set_callback_option(read_ascii_file); - set_callback_option(read_binary_file); - set_callback_option(close_file); - set_callback_option(eof_file); - set_callback_option(flush_file); - set_callback_option(write_ascii_file); - set_callback_option(write_binary_file); - set_callback_option(shipout_backend); - if (opt->banner && *(opt->banner)) { - mp->banner = xstrdup(opt->banner); - } else { - mp->banner = xstrdup(default_banner); - } - if (opt->command_line && *(opt->command_line)) - mp->command_line = xstrdup(opt->command_line); - if (mp->noninteractive) { - @<Prepare function pointers for non-interactive use@>; - } - /* open the terminal for output */ - t_open_out; - @<Find constant sizes@>; - @<Allocate or initialize variables@> - mp_reallocate_memory(mp,mp->mem_max); - mp_reallocate_paths(mp,1000); - mp_reallocate_fonts(mp,8); - mp->history=mp_fatal_error_stop; /* in case we quit during initialization */ - @<Check the ``constant'' values...@>; - if ( mp->bad>0 ) { - char ss[256]; - mp_snprintf(ss,256,"Ouch---my internal constants have been clobbered!\n" - "---case %i",(int)mp->bad); - do_fprintf(mp->err_out,(char *)ss); -@.Ouch...clobbered@> - return mp; - } - mp_do_initialize(mp); /* erase preloaded mem */ - if (mp->ini_version) { - @<Run inimpost commands@>; - } - if (!mp->noninteractive) { - @<Initialize the output routines@>; - @<Get the first line of input and prepare to start@>; - @<Initializations after first line is read@>; - } else { - mp->history=mp_spotless; - } - return mp; -} - -@ @<Initializations after first line is read@>= -mp_open_log_file(mp); -mp_set_job_id(mp); -mp_init_map_file(mp, mp->troff_mode); -mp->history=mp_spotless; /* ready to go! */ -if (mp->troff_mode) { - mp->internal[mp_gtroffmode]=unity; - mp->internal[mp_prologues]=unity; -} -if ( mp->start_sym>0 ) { /* insert the `\&{everyjob}' symbol */ - mp->cur_sym=mp->start_sym; mp_back_input(mp); -} - -@ @<Exported function headers@>= -extern MP_options *mp_options (void); -extern MP mp_initialize (MP_options *opt) ; -extern int mp_status(MP mp); -extern void *mp_userdata(MP mp); - -@ @c -int mp_status(MP mp) { return mp->history; } - -@ @c -void *mp_userdata(MP mp) { return mp->userdata; } - -@ The overall \MP\ program begins with the heading just shown, after which -comes a bunch of procedure declarations and function declarations. -Finally we will get to the main program, which begins with the -comment `|start_here|'. If you want to skip down to the -main program now, you can look up `|start_here|' in the index. -But the author suggests that the best way to understand this program -is to follow pretty much the order of \MP's components as they appear in the -\.{WEB} description you are now reading, since the present ordering is -intended to combine the advantages of the ``bottom up'' and ``top down'' -approaches to the problem of understanding a somewhat complicated system. - -@ Some of the code below is intended to be used only when diagnosing the -strange behavior that sometimes occurs when \MP\ is being installed or -when system wizards are fooling around with \MP\ without quite knowing -what they are doing. Such code will not normally be compiled; it is -delimited by the preprocessor test `|#ifdef DEBUG .. #endif|'. - -@ This program has two important variations: (1) There is a long and slow -version called \.{INIMP}, which does the extra calculations needed to -@.INIMP@> -initialize \MP's internal tables; and (2)~there is a shorter and faster -production version, which cuts the initialization to a bare minimum. - -Which is which is decided at runtime. - -@ The following parameters can be changed at compile time to extend or -reduce \MP's capacity. They may have different values in \.{INIMP} and -in production versions of \MP. -@.INIMP@> -@^system dependencies@> - -@<Constants...@>= -#define file_name_size 255 /* file names shouldn't be longer than this */ -#define bistack_size 1500 /* size of stack for bisection algorithms; - should probably be left at this value */ - -@ Like the preceding parameters, the following quantities can be changed -to extend or reduce \MP's capacity. But if they are changed, -it is necessary to rerun the initialization program \.{INIMP} -@.INIMP@> -to generate new tables for the production \MP\ program. -One can't simply make helter-skelter changes to the following constants, -since certain rather complex initialization -numbers are computed from them. - -@ @<Glob...@>= -int max_strings; /* maximum number of strings; must not exceed |max_halfword| */ -int pool_size; /* maximum number of characters in strings, including all - error messages and help texts, and the names of all identifiers */ -int old_pool_size; /* a helper used by |mp_cat| */ -int mem_max; /* greatest index in \MP's internal |mem| array; - must be strictly less than |max_halfword|; - must be equal to |mem_top| in \.{INIMP}, otherwise |>=mem_top| */ -int mem_top; /* largest index in the |mem| array dumped by \.{INIMP}; - must not be greater than |mem_max| */ -int hash_prime; /* a prime number equal to about 85\pct! of |hash_size| */ - -@ @<Option variables@>= -int error_line; /* width of context lines on terminal error messages */ -int half_error_line; /* width of first lines of contexts in terminal - error messages; should be between 30 and |error_line-15| */ -int max_print_line; /* width of longest text lines output; should be at least 60 */ -unsigned hash_size; /* maximum number of symbolic tokens, - must be less than |max_halfword-3*param_size| */ -int param_size; /* maximum number of simultaneous macro parameters */ -int max_in_open; /* maximum number of input files and error insertions that - can be going on simultaneously */ -int main_memory; /* only for options, to set up |mem_max| and |mem_top| */ -void *userdata; /* this allows the calling application to setup local */ -char *banner; /* the banner that is printed to the screen and log */ - -@ @<Dealloc variables@>= -xfree(mp->banner); - -@ -@d set_value(a,b,c) do { a=c; if (b>c) a=b; } while (0) - -@<Allocate or ...@>= -mp->max_strings=500; -mp->pool_size=10000; -mp->old_pool_size=10000; -set_value(mp->error_line,opt->error_line,79); -set_value(mp->half_error_line,opt->half_error_line,50); -if (mp->half_error_line>mp->error_line-15 ) - mp->half_error_line = mp->error_line-15; -mp->max_print_line=100; -set_value(mp->max_print_line,opt->max_print_line,79); - -@ In case somebody has inadvertently made bad settings of the ``constants,'' -\MP\ checks them using a global variable called |bad|. - -This is the second of many sections of \MP\ where global variables are -defined. - -@<Glob...@>= -integer bad; /* is some ``constant'' wrong? */ - -@ Later on we will say `\ignorespaces|if (mem_max>=max_halfword) bad=10;|', -or something similar. (We can't do that until |max_halfword| has been defined.) - -In case you are wondering about the non-consequtive values of |bad|: some -of the things that used to be WEB constants are now runtime variables -with checking at assignment time. - -@<Check the ``constant'' values for consistency@>= -mp->bad=0; -if ( mp->mem_top<=1100 ) mp->bad=4; - -@ Some |goto| labels are used by the following definitions. The label -`|restart|' is occasionally used at the very beginning of a procedure; and -the label `|reswitch|' is occasionally used just prior to a |case| -statement in which some cases change the conditions and we wish to branch -to the newly applicable case. Loops that are set up with the |loop| -construction defined below are commonly exited by going to `|done|' or to -`|found|' or to `|not_found|', and they are sometimes repeated by going to -`|continue|'. If two or more parts of a subroutine start differently but -end up the same, the shared code may be gathered together at -`|common_ending|'. - -@ Here are some macros for common programming idioms. - -@d incr(A) (A)=(A)+1 /* increase a variable by unity */ -@d decr(A) (A)=(A)-1 /* decrease a variable by unity */ -@d negate(A) (A)=-(A) /* change the sign of a variable */ -@d double(A) (A)=(A)+(A) -@d odd(A) ((A)%2==1) -@d do_nothing /* empty statement */ - -@* \[2] The character set. -In order to make \MP\ readily portable to a wide variety of -computers, all of its input text is converted to an internal eight-bit -code that includes standard ASCII, the ``American Standard Code for -Information Interchange.'' This conversion is done immediately when each -character is read in. Conversely, characters are converted from ASCII to -the user's external representation just before they are output to a -text file. -@^ASCII code@> - -Such an internal code is relevant to users of \MP\ only with respect to -the \&{char} and \&{ASCII} operations, and the comparison of strings. - -@ Characters of text that have been converted to \MP's internal form -are said to be of type |ASCII_code|, which is a subrange of the integers. - -@<Types...@>= -typedef unsigned char ASCII_code; /* eight-bit numbers */ - -@ The present specification of \MP\ has been written under the assumption -that the character set contains at least the letters and symbols associated -with ASCII codes 040 through 0176; all of these characters are now -available on most computer terminals. - -@<Types...@>= -typedef unsigned char text_char; /* the data type of characters in text files */ - -@ @<Local variables for init...@>= -integer i; - -@ The \MP\ processor converts between ASCII code and -the user's external character set by means of arrays |xord| and |xchr| -that are analogous to Pascal's |ord| and |chr| functions. - -@(mpmp.h@>= -#define xchr(A) mp->xchr[(A)] -#define xord(A) mp->xord[(A)] - -@ @<Glob...@>= -ASCII_code xord[256]; /* specifies conversion of input characters */ -text_char xchr[256]; /* specifies conversion of output characters */ - -@ The core system assumes all 8-bit is acceptable. If it is not, -a change file has to alter the below section. -@^system dependencies@> - -Additionally, people with extended character sets can -assign codes arbitrarily, giving an |xchr| equivalent to whatever -characters the users of \MP\ are allowed to have in their input files. -Appropriate changes to \MP's |char_class| table should then be made. -(Unlike \TeX, each installation of \MP\ has a fixed assignment of category -codes, called the |char_class|.) Such changes make portability of programs -more difficult, so they should be introduced cautiously if at all. -@^character set dependencies@> -@^system dependencies@> - -@<Set initial ...@>= -for (i=0;i<=0377;i++) { xchr(i)=(text_char)i; } - -@ The following system-independent code makes the |xord| array contain a -suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]| -where |i<j<0177|, the value of |xord[xchr[i]]| will turn out to be -|j| or more; hence, standard ASCII code numbers will be used instead of -codes below 040 in case there is a coincidence. - -@<Set initial ...@>= -for (i=0;i<=255;i++) { - xord(xchr(i))=0177; -} -for (i=0200;i<=0377;i++) { xord(xchr(i))=(ASCII_code)i;} -for (i=0;i<=0176;i++) { xord(xchr(i))=(ASCII_code)i;} - -@* \[3] Input and output. -The bane of portability is the fact that different operating systems treat -input and output quite differently, perhaps because computer scientists -have not given sufficient attention to this problem. People have felt somehow -that input and output are not part of ``real'' programming. Well, it is true -that some kinds of programming are more fun than others. With existing -input/output conventions being so diverse and so messy, the only sources of -joy in such parts of the code are the rare occasions when one can find a -way to make the program a little less bad than it might have been. We have -two choices, either to attack I/O now and get it over with, or to postpone -I/O until near the end. Neither prospect is very attractive, so let's -get it over with. - -The basic operations we need to do are (1)~inputting and outputting of -text, to or from a file or the user's terminal; (2)~inputting and -outputting of eight-bit bytes, to or from a file; (3)~instructing the -operating system to initiate (``open'') or to terminate (``close'') input or -output from a specified file; (4)~testing whether the end of an input -file has been reached; (5)~display of bits on the user's screen. -The bit-display operation will be discussed in a later section; we shall -deal here only with more traditional kinds of I/O. - -@ Finding files happens in a slightly roundabout fashion: the \MP\ -instance object contains a field that holds a function pointer that finds a -file, and returns its name, or NULL. For this, it receives three -parameters: the non-qualified name |fname|, the intended |fopen| -operation type |fmode|, and the type of the file |ftype|. - -The file types that are passed on in |ftype| can be used to -differentiate file searches if a library like kpathsea is used, -the fopen mode is passed along for the same reason. - -@<Types...@>= -typedef unsigned char eight_bits ; /* unsigned one-byte quantity */ - -@ @<Exported types@>= -enum mp_filetype { - mp_filetype_terminal = 0, /* the terminal */ - mp_filetype_error, /* the terminal */ - mp_filetype_program , /* \MP\ language input */ - mp_filetype_log, /* the log file */ - mp_filetype_postscript, /* the postscript output */ - mp_filetype_memfile, /* memory dumps */ - mp_filetype_metrics, /* TeX font metric files */ - mp_filetype_fontmap, /* PostScript font mapping files */ - mp_filetype_font, /* PostScript type1 font programs */ - mp_filetype_encoding, /* PostScript font encoding files */ - mp_filetype_text /* first text file for readfrom and writeto primitives */ -}; -typedef char *(*mp_file_finder)(MP, const char *, const char *, int); -typedef void *(*mp_file_opener)(MP, const char *, const char *, int); -typedef char *(*mp_file_reader)(MP, void *, size_t *); -typedef void (*mp_binfile_reader)(MP, void *, void **, size_t *); -typedef void (*mp_file_closer)(MP, void *); -typedef int (*mp_file_eoftest)(MP, void *); -typedef void (*mp_file_flush)(MP, void *); -typedef void (*mp_file_writer)(MP, void *, const char *); -typedef void (*mp_binfile_writer)(MP, void *, void *, size_t); - -@ @<Option variables@>= -mp_file_finder find_file; -mp_file_opener open_file; -mp_file_reader read_ascii_file; -mp_binfile_reader read_binary_file; -mp_file_closer close_file; -mp_file_eoftest eof_file; -mp_file_flush flush_file; -mp_file_writer write_ascii_file; -mp_binfile_writer write_binary_file; - -@ The default function for finding files is |mp_find_file|. It is -pretty stupid: it will only find files in the current directory. - -This function may disappear altogether, it is currently only -used for the default font map file. - -@c -static char *mp_find_file (MP mp, const char *fname, const char *fmode, int ftype) { - (void) mp; - if (fmode[0] != 'r' || (! access (fname,R_OK)) || ftype) { - return mp_strdup(fname); - } - return NULL; -} - -@ Because |mp_find_file| is used so early, it has to be in the helpers -section. - -@<Declarations@>= -static char *mp_find_file (MP mp, const char *fname, const char *fmode, int ftype) ; -static void *mp_open_file (MP mp , const char *fname, const char *fmode, int ftype) ; -static char *mp_read_ascii_file (MP mp, void *f, size_t *size) ; -static void mp_read_binary_file (MP mp, void *f, void **d, size_t *size) ; -static void mp_close_file (MP mp, void *f) ; -static int mp_eof_file (MP mp, void *f) ; -static void mp_flush_file (MP mp, void *f) ; -static void mp_write_ascii_file (MP mp, void *f, const char *s) ; -static void mp_write_binary_file (MP mp, void *f, void *s, size_t t) ; - -@ The function to open files can now be very short. - -@c -void *mp_open_file(MP mp, const char *fname, const char *fmode, int ftype) { - char realmode[3]; - (void) mp; - realmode[0] = *fmode; - realmode[1] = 'b'; - realmode[2] = 0; - if (ftype==mp_filetype_terminal) { - return (fmode[0] == 'r' ? stdin : stdout); - } else if (ftype==mp_filetype_error) { - return stderr; - } else if (fname != NULL && (fmode[0] != 'r' || (! access (fname,R_OK)))) { - return (void *)fopen(fname, realmode); - } - return NULL; -} - -@ This is a legacy interface: (almost) all file names pass through |name_of_file|. - -@<Glob...@>= -char name_of_file[file_name_size+1]; /* the name of a system file */ -int name_length;/* this many characters are actually - relevant in |name_of_file| (the rest are blank) */ - -@ If this parameter is true, the terminal and log will report the found -file names for input files instead of the requested ones. -It is off by default because it creates an extra filename lookup. - -@<Option variables@>= -int print_found_names; /* configuration parameter */ - -@ @<Allocate or initialize ...@>= -mp->print_found_names = (opt->print_found_names>0 ? true : false); - -@ The |file_line_error_style| parameter makes \MP\ use a more -standard compiler error message format instead of the Knuthian -exclamation mark. It needs the actual version of the current input -file name, that will be saved by |a_open_in| in the global -|mp->long_name|. - -@<Glob...@>= -char *long_name; - -@ @<Option variables@>= -int file_line_error_style; /* configuration parameter */ - -@ @<Allocate or initialize ...@>= -mp->file_line_error_style = (opt->file_line_error_style>0 ? true : false); -mp->long_name = NULL; - -@ \MP's file-opening procedures return |false| if no file identified by -|name_of_file| could be opened. - -The |OPEN_FILE| macro takes care of the |print_found_names| parameter. -It is not used for opening a mem file for read, because that file name -is never printed. - -@d OPEN_FILE(A) do { - if (mp->print_found_names || mp->file_line_error_style) { - char *s = (mp->find_file)(mp,mp->name_of_file,A,ftype); - if (s!=NULL) { - *f = (mp->open_file)(mp,mp->name_of_file,A, ftype); - if (mp->print_found_names) { - strncpy(mp->name_of_file,s,file_name_size); - } - if ((*(A) == 'r') && (ftype == mp_filetype_program)) { - xfree(mp->long_name); - mp->long_name = xstrdup(s); - } - xfree(s); - } else { - *f = NULL; - } - } else { - *f = (mp->open_file)(mp,mp->name_of_file,A, ftype); - } -} while (0); -return (*f ? true : false) - -@c -static boolean mp_a_open_in (MP mp, void **f, int ftype) { - /* open a text file for input */ - OPEN_FILE("r"); -} -@# -boolean mp_w_open_in (MP mp, void **f) { - /* open a word file for input */ - *f = (mp->open_file)(mp,mp->name_of_file,"r",mp_filetype_memfile); - return (*f ? true : false); -} -@# -static boolean mp_a_open_out (MP mp, void **f, int ftype) { - /* open a text file for output */ - OPEN_FILE("w"); -} -@# -static boolean mp_b_open_out (MP mp, void **f, int ftype) { - /* open a binary file for output */ - OPEN_FILE("w"); -} -@# -boolean mp_w_open_out (MP mp, void **f) { - /* open a word file for output */ - int ftype = mp_filetype_memfile; - OPEN_FILE("w"); -} - -@ @<Internal library ...@>= -boolean mp_w_open_out (MP mp, void **f); - -@ @c -static char *mp_read_ascii_file (MP mp, void *ff, size_t *size) { - int c; - size_t len = 0, lim = 128; - char *s = NULL; - FILE *f = (FILE *)ff; - *size = 0; - (void) mp; /* for -Wunused */ - if (f==NULL) - return NULL; - c = fgetc(f); - if (c==EOF) - return NULL; - s = malloc(lim); - if (s==NULL) return NULL; - while (c!=EOF && c!='\n' && c!='\r') { - if ((len+1)==lim) { - s =realloc(s, (lim+(lim>>2))); - if (s==NULL) return NULL; - lim+=(lim>>2); - } - s[len++] = c; - c =fgetc(f); - } - if (c=='\r') { - c = fgetc(f); - if (c!=EOF && c!='\n') - ungetc(c,f); - } - s[len] = 0; - *size = len; - return s; -} - -@ @c -void mp_write_ascii_file (MP mp, void *f, const char *s) { - (void) mp; - if (f!=NULL) { - fputs(s,(FILE *)f); - } -} - -@ @c -void mp_read_binary_file (MP mp, void *f, void **data, size_t *size) { - size_t len = 0; - (void) mp; - if (f!=NULL) - len = fread(*data,1,*size,(FILE *)f); - *size = len; -} - -@ @c -void mp_write_binary_file (MP mp, void *f, void *s, size_t size) { - (void) mp; - if (f!=NULL) - (void)fwrite(s,size,1,(FILE *)f); -} - - -@ @c -void mp_close_file (MP mp, void *f) { - (void) mp; - if (f!=NULL) - fclose((FILE *)f); -} - -@ @c -int mp_eof_file (MP mp, void *f) { - (void) mp; - if (f!=NULL) - return feof((FILE *)f); - else - return 1; -} - -@ @c -void mp_flush_file (MP mp, void *f) { - (void) mp; - if (f!=NULL) - fflush((FILE *)f); -} - -@ Input from text files is read one line at a time, using a routine called -|input_ln|. This function is defined in terms of global variables called -|buffer|, |first|, and |last| that will be described in detail later; for -now, it suffices for us to know that |buffer| is an array of |ASCII_code| -values, and that |first| and |last| are indices into this array -representing the beginning and ending of a line of text. - -@<Glob...@>= -size_t buf_size; /* maximum number of characters simultaneously present in - current lines of open files */ -ASCII_code *buffer; /* lines of characters being read */ -size_t first; /* the first unused position in |buffer| */ -size_t last; /* end of the line just input to |buffer| */ -size_t max_buf_stack; /* largest index used in |buffer| */ - -@ @<Allocate or initialize ...@>= -mp->buf_size = 200; -mp->buffer = xmalloc((mp->buf_size+1),sizeof(ASCII_code)); - -@ @<Dealloc variables@>= -xfree(mp->buffer); - -@ @c -static void mp_reallocate_buffer(MP mp, size_t l) { - ASCII_code *buffer; - if (l>max_halfword) { - mp_confusion(mp,"buffer size"); /* can't happen (I hope) */ - } - buffer = xmalloc((l+1),sizeof(ASCII_code)); - memcpy(buffer,mp->buffer,(mp->buf_size+1)); - xfree(mp->buffer); - mp->buffer = buffer ; - mp->buf_size = l; -} - -@ The |input_ln| function brings the next line of input from the specified -field into available positions of the buffer array and returns the value -|true|, unless the file has already been entirely read, in which case it -returns |false| and sets |last:=first|. In general, the |ASCII_code| -numbers that represent the next line of the file are input into -|buffer[first]|, |buffer[first+1]|, \dots, |buffer[last-1]|; and the -global variable |last| is set equal to |first| plus the length of the -line. Trailing blanks are removed from the line; thus, either |last=first| -(in which case the line was entirely blank) or |buffer[last-1]<>" "|. -@^inner loop@> - -The variable |max_buf_stack|, which is used to keep track of how large -the |buf_size| parameter must be to accommodate the present job, is -also kept up to date by |input_ln|. - -@c -static boolean mp_input_ln (MP mp, void *f ) { - /* inputs the next line or returns |false| */ - char *s; - size_t size = 0; - mp->last=mp->first; /* cf.\ Matthew 19\thinspace:\thinspace30 */ - s = (mp->read_ascii_file)(mp,f, &size); - if (s==NULL) - return false; - if (size>0) { - mp->last = mp->first+size; - if ( mp->last>=mp->max_buf_stack ) { - mp->max_buf_stack=mp->last+1; - while ( mp->max_buf_stack>mp->buf_size ) { - mp_reallocate_buffer(mp,(mp->buf_size+(mp->buf_size>>2))); - } - } - memcpy((mp->buffer+mp->first),s,size); - /* while ( mp->buffer[mp->last]==' ' ) mp->last--; */ - } - free(s); - return true; -} - -@ The user's terminal acts essentially like other files of text, except -that it is used both for input and for output. When the terminal is -considered an input file, the file variable is called |term_in|, and when it -is considered an output file the file variable is |term_out|. -@^system dependencies@> - -@<Glob...@>= -void * term_in; /* the terminal as an input file */ -void * term_out; /* the terminal as an output file */ -void * err_out; /* the terminal as an output file */ - -@ Here is how to open the terminal files. In the default configuration, -nothing happens except that the command line (if there is one) is copied -to the input buffer. The variable |command_line| will be filled by the -|main| procedure. The copying can not be done earlier in the program -logic because in the |INI| version, the |buffer| is also used for primitive -initialization. - -@d t_open_out do {/* open the terminal for text output */ - mp->term_out = (mp->open_file)(mp,"terminal", "w", mp_filetype_terminal); - mp->err_out = (mp->open_file)(mp,"error", "w", mp_filetype_error); -} while (0) -@d t_open_in do { /* open the terminal for text input */ - mp->term_in = (mp->open_file)(mp,"terminal", "r", mp_filetype_terminal); - if (mp->command_line!=NULL) { - mp->last = strlen(mp->command_line); - strncpy((char *)mp->buffer,mp->command_line,mp->last); - xfree(mp->command_line); - } else { - mp->last = 0; - } -} while (0) - -@<Option variables@>= -char *command_line; - -@ Sometimes it is necessary to synchronize the input/output mixture that -happens on the user's terminal, and three system-dependent -procedures are used for this -purpose. The first of these, |update_terminal|, is called when we want -to make sure that everything we have output to the terminal so far has -actually left the computer's internal buffers and been sent. -The second, |clear_terminal|, is called when we wish to cancel any -input that the user may have typed ahead (since we are about to -issue an unexpected error message). The third, |wake_up_terminal|, -is supposed to revive the terminal if the user has disabled it by -some instruction to the operating system. The following macros show how -these operations can be specified: -@^system dependencies@> - -@(mpmp.h@>= -#define update_terminal (mp->flush_file)(mp,mp->term_out) /* empty the terminal output buffer */ -#define clear_terminal do_nothing /* clear the terminal input buffer */ -#define wake_up_terminal (mp->flush_file)(mp,mp->term_out) - /* cancel the user's cancellation of output */ - -@ We need a special routine to read the first line of \MP\ input from -the user's terminal. This line is different because it is read before we -have opened the transcript file; there is sort of a ``chicken and -egg'' problem here. If the user types `\.{input cmr10}' on the first -line, or if some macro invoked by that line does such an \.{input}, -the transcript file will be named `\.{cmr10.log}'; but if no \.{input} -commands are performed during the first line of terminal input, the transcript -file will acquire its default name `\.{mpout.log}'. (The transcript file -will not contain error messages generated by the first line before the -first \.{input} command.) - -The first line is even more special. It's nice to let the user start -running a \MP\ job by typing a command line like `\.{MP cmr10}'; in -such a case, \MP\ will operate as if the first line of input were -`\.{cmr10}', i.e., the first line will consist of the remainder of the -command line, after the part that invoked \MP. - -@ Different systems have different ways to get started. But regardless of -what conventions are adopted, the routine that initializes the terminal -should satisfy the following specifications: - -\yskip\textindent{1)}It should open file |term_in| for input from the - terminal. (The file |term_out| will already be open for output to the - terminal.) - -\textindent{2)}If the user has given a command line, this line should be - considered the first line of terminal input. Otherwise the - user should be prompted with `\.{**}', and the first line of input - should be whatever is typed in response. - -\textindent{3)}The first line of input, which might or might not be a - command line, should appear in locations |first| to |last-1| of the - |buffer| array. - -\textindent{4)}The global variable |loc| should be set so that the - character to be read next by \MP\ is in |buffer[loc]|. This - character should not be blank, and we should have |loc<last|. - -\yskip\noindent(It may be necessary to prompt the user several times -before a non-blank line comes in. The prompt is `\.{**}' instead of the -later `\.*' because the meaning is slightly different: `\.{input}' need -not be typed immediately after~`\.{**}'.) - -@d loc mp->cur_input.loc_field /* location of first unread character in |buffer| */ - -@c -boolean mp_init_terminal (MP mp) { /* gets the terminal input started */ - t_open_in; - if (mp->last!=0) { - loc = 0; mp->first = 0; - return true; - } - while (1) { - if (!mp->noninteractive) { - wake_up_terminal; do_fprintf(mp->term_out,"**"); update_terminal; -@.**@> - } - if ( ! mp_input_ln(mp, mp->term_in ) ) { /* this shouldn't happen */ - do_fprintf(mp->term_out,"\n! End of file on the terminal... why?"); -@.End of file on the terminal@> - return false; - } - loc=(halfword)mp->first; - while ( (loc<(int)mp->last)&&(mp->buffer[loc]==' ') ) - incr(loc); - if ( loc<(int)mp->last ) { - return true; /* return unless the line was all blank */ - } - if (!mp->noninteractive) { - do_fprintf(mp->term_out,"Please type the name of your input file.\n"); - } - } -} - -@ @<Declarations@>= -static boolean mp_init_terminal (MP mp) ; - - -@* \[4] String handling. -Symbolic token names and diagnostic messages are variable-length strings -of eight-bit characters. Many strings \MP\ uses are simply literals -in the compiled source, like the error messages and the names of the -internal parameters. Other strings are used or defined from the \MP\ input -language, and these have to be interned. - -\MP\ uses strings more extensively than \MF\ does, but the necessary -operations can still be handled with a fairly simple data structure. -The array |str_pool| contains all of the (eight-bit) ASCII codes in all -of the strings, and the array |str_start| contains indices of the starting -points of each string. Strings are referred to by integer numbers, so that -string number |s| comprises the characters |str_pool[j]| for -|str_start[s]<=j<str_start[ss]| where |ss=next_str[s]|. The string pool -is allocated sequentially and |str_pool[pool_ptr]| is the next unused -location. The first string number not currently in use is |str_ptr| -and |next_str[str_ptr]| begins a list of free string numbers. String -pool entries |str_start[str_ptr]| up to |pool_ptr| are reserved for a -string currently being constructed. - -String numbers 0 to 255 are reserved for strings that correspond to single -ASCII characters. This is in accordance with the conventions of \.{WEB}, -@.WEB@> -which converts single-character strings into the ASCII code number of the -single character involved, while it converts other strings into integers -and builds a string pool file. Thus, when the string constant \.{"."} appears -in the program below, \.{WEB} converts it into the integer 46, which is the -ASCII code for a period, while \.{WEB} will convert a string like \.{"hello"} -into some integer greater than~255. String number 46 will presumably be the -single character `\..'\thinspace; but some ASCII codes have no standard visible -representation, and \MP\ may need to be able to print an arbitrary -ASCII character, so the first 256 strings are used to specify exactly what -should be printed for each of the 256 possibilities. - -@<Types...@>= -typedef int pool_pointer; /* for variables that point into |str_pool| */ -typedef int str_number; /* for variables that point into |str_start| */ - -@ @<Glob...@>= -ASCII_code *str_pool; /* the characters */ -pool_pointer *str_start; /* the starting pointers */ -str_number *next_str; /* for linking strings in order */ -pool_pointer pool_ptr; /* first unused position in |str_pool| */ -str_number str_ptr; /* number of the current string being created */ -pool_pointer init_pool_ptr; /* the starting value of |pool_ptr| */ -str_number init_str_use; /* the initial number of strings in use */ -pool_pointer max_pool_ptr; /* the maximum so far of |pool_ptr| */ -str_number max_str_ptr; /* the maximum so far of |str_ptr| */ - -@ @<Allocate or initialize ...@>= -mp->str_pool = xmalloc ((mp->pool_size +1),sizeof(ASCII_code)); -mp->str_start = xmalloc ((mp->max_strings+1),sizeof(pool_pointer)); -mp->next_str = xmalloc ((mp->max_strings+1),sizeof(str_number)); - -@ @<Dealloc variables@>= -xfree(mp->str_pool); -xfree(mp->str_start); -xfree(mp->next_str); - -@ Most printing is done from |char *|s, but sometimes not. Here are -functions that convert an internal string into a |char *| for use -by the printing routines, and vice versa. - -@d str(A) mp_str(mp,A) -@d rts(A) mp_rts(mp,A) -@d null_str rts("") - -@<Internal ...@>= -int mp_xstrcmp (const char *a, const char *b); -char * mp_str (MP mp, str_number s); - -@ @<Declarations@>= -static str_number mp_rts (MP mp, const char *s); -static str_number mp_make_string (MP mp); - -@ @c -int mp_xstrcmp (const char *a, const char *b) { - if (a==NULL && b==NULL) - return 0; - if (a==NULL) - return -1; - if (b==NULL) - return 1; - return strcmp(a,b); -} - -@ The attempt to catch interrupted strings that is in |mp_rts|, is not -very good: it does not handle nesting over more than one level. - -@c -char * mp_str (MP mp, str_number ss) { - char *s; - size_t len; - if (ss==mp->str_ptr) { - return NULL; - } else { - len = (size_t)length(ss); - s = xmalloc(len+1,sizeof(char)); - strncpy(s,(char *)(mp->str_pool+(mp->str_start[ss])),len); - s[len] = 0; - return (char *)s; - } -} -str_number mp_rts (MP mp, const char *s) { - int r; /* the new string */ - int old; /* a possible string in progress */ - int i=0; - if (strlen(s)==0) { - return 256; - } else if (strlen(s)==1) { - return s[0]; - } else { - old=0; - str_room((integer)strlen(s)); - if (mp->str_start[mp->str_ptr]<mp->pool_ptr) - old = mp_make_string(mp); - while (*s) { - append_char(*s); - s++; - } - r = mp_make_string(mp); - if (old!=0) { - str_room(length(old)); - while (i<length(old)) { - append_char((mp->str_start[old]+i)); - } - mp_flush_string(mp,old); - } - return r; - } -} - -@ Except for |strs_used_up|, the following string statistics are only -maintained when code between |stat| $\ldots$ |tats| delimiters is not -commented out: - -@<Glob...@>= -integer strs_used_up; /* strings in use or unused but not reclaimed */ -integer pool_in_use; /* total number of cells of |str_pool| actually in use */ -integer strs_in_use; /* total number of strings actually in use */ -integer max_pl_used; /* maximum |pool_in_use| so far */ -integer max_strs_used; /* maximum |strs_in_use| so far */ - -@ Several of the elementary string operations are performed using \.{WEB} -macros instead of functions, because many of the -operations are done quite frequently and we want to avoid the -overhead of procedure calls. For example, here is -a simple macro that computes the length of a string. -@.WEB@> - -@d str_stop(A) mp->str_start[mp->next_str[(A)]] /* one cell past the end of string \# */ -@d length(A) (str_stop((A))-mp->str_start[(A)]) /* the number of characters in string \# */ - -@ The length of the current string is called |cur_length|. If we decide that -the current string is not needed, |flush_cur_string| resets |pool_ptr| so that -|cur_length| becomes zero. - -@d cur_length (mp->pool_ptr - mp->str_start[mp->str_ptr]) -@d flush_cur_string mp->pool_ptr=mp->str_start[mp->str_ptr] - -@ Strings are created by appending character codes to |str_pool|. -The |append_char| macro, defined here, does not check to see if the -value of |pool_ptr| has gotten too high; this test is supposed to be -made before |append_char| is used. - -To test if there is room to append |l| more characters to |str_pool|, -we shall write |str_room(l)|, which tries to make sure there is enough room -by compacting the string pool if necessary. If this does not work, -|do_compaction| aborts \MP\ and gives an apologetic error message. - -@d append_char(A) /* put |ASCII_code| \# at the end of |str_pool| */ -{ mp->str_pool[mp->pool_ptr]=(ASCII_code)(A); incr(mp->pool_ptr); -} -@d str_room(A) /* make sure that the pool hasn't overflowed */ - { if ( mp->pool_ptr+(A) > mp->max_pool_ptr ) { - if ( mp->pool_ptr+(A) > mp->pool_size ) mp_do_compaction(mp, (A)); - else mp->max_pool_ptr=mp->pool_ptr+(A); } - } - -@ The following routine is similar to |str_room(1)| but it uses the -argument |mp->pool_size| to prevent |do_compaction| from aborting when -string space is exhausted. - -@<Declarations@>= -static void mp_unit_str_room (MP mp); - -@ @c -void mp_unit_str_room (MP mp) { - if ( mp->pool_ptr>=mp->pool_size ) mp_do_compaction(mp, mp->pool_size); - if ( mp->pool_ptr>=mp->max_pool_ptr ) mp->max_pool_ptr=mp->pool_ptr+1; -} - -@ \MP's string expressions are implemented in a brute-force way: Every -new string or substring that is needed is simply copied into the string pool. -Space is eventually reclaimed by a procedure called |do_compaction| with -the aid of a simple system system of reference counts. -@^reference counts@> - -The number of references to string number |s| will be |str_ref[s]|. The -special value |str_ref[s]=max_str_ref=127| is used to denote an unknown -positive number of references; such strings will never be recycled. If -a string is ever referred to more than 126 times, simultaneously, we -put it in this category. Hence a single byte suffices to store each |str_ref|. - -@d max_str_ref 127 /* ``infinite'' number of references */ -@d add_str_ref(A) { if ( mp->str_ref[(A)]<max_str_ref ) incr(mp->str_ref[(A)]); } - -@<Glob...@>= -int *str_ref; - -@ @<Allocate or initialize ...@>= -mp->str_ref = xmalloc ((mp->max_strings+1),sizeof(int)); - -@ @<Dealloc variables@>= -xfree(mp->str_ref); - -@ Here's what we do when a string reference disappears: - -@d delete_str_ref(A) { - if ( mp->str_ref[(A)]<max_str_ref ) { - if ( mp->str_ref[(A)]>1 ) decr(mp->str_ref[(A)]); - else mp_flush_string(mp, (A)); - } - } - -@<Declarations@>= -static void mp_flush_string (MP mp,str_number s) ; - -@ We can't flush the first set of static strings at all, so there -is no point in trying - -@c -void mp_flush_string (MP mp,str_number s) { - if (length(s)>1) { - mp->pool_in_use=mp->pool_in_use-length(s); - decr(mp->strs_in_use); - if ( mp->next_str[s]!=mp->str_ptr ) { - mp->str_ref[s]=0; - } else { - mp->str_ptr=s; - decr(mp->strs_used_up); - } - mp->pool_ptr=mp->str_start[mp->str_ptr]; - } -} - -@ C literals cannot be simply added, they need to be set so they can't -be flushed. - -@d intern(A) mp_intern(mp,(A)) - -@c -str_number mp_intern (MP mp, const char *s) { - str_number r ; - r = rts(s); - mp->str_ref[r] = max_str_ref; - return r; -} - -@ @<Declarations@>= -static str_number mp_intern (MP mp, const char *s); - - -@ Once a sequence of characters has been appended to |str_pool|, it -officially becomes a string when the function |make_string| is called. -This function returns the identification number of the new string as its -value. - -When getting the next unused string number from the linked list, we pretend -that -$$ \hbox{|max_str_ptr+1|, |max_str_ptr+2|, $\ldots$, |mp->max_strings|} $$ -are linked sequentially even though the |next_str| entries have not been -initialized yet. We never allow |str_ptr| to reach |mp->max_strings|; -|do_compaction| is responsible for making sure of this. - -@<Declarations@>= -static str_number mp_make_string (MP mp); - -@ @c -str_number mp_make_string (MP mp) { /* current string enters the pool */ - str_number s; /* the new string */ -RESTART: - s=mp->str_ptr; - mp->str_ptr=mp->next_str[s]; - if ( mp->str_ptr>mp->max_str_ptr ) { - if ( mp->str_ptr==mp->max_strings ) { - mp->str_ptr=s; - mp_do_compaction(mp, 0); - goto RESTART; - } else { - mp->max_str_ptr=mp->str_ptr; - mp->next_str[mp->str_ptr]=mp->max_str_ptr+1; - } - } - mp->str_ref[s]=1; - mp->str_start[mp->str_ptr]=mp->pool_ptr; - incr(mp->strs_used_up); - incr(mp->strs_in_use); - mp->pool_in_use=mp->pool_in_use+length(s); - if ( mp->pool_in_use>mp->max_pl_used ) - mp->max_pl_used=mp->pool_in_use; - if ( mp->strs_in_use>mp->max_strs_used ) - mp->max_strs_used=mp->strs_in_use; - return s; -} - -@ The most interesting string operation is string pool compaction. The idea -is to recover unused space in the |str_pool| array by recopying the strings -to close the gaps created when some strings become unused. All string -numbers~$k$ where |str_ref[k]=0| are to be linked into the list of free string -numbers after |str_ptr|. If this fails to free enough pool space we issue an -|overflow| error unless |needed=mp->pool_size|. Calling |do_compaction| -with |needed=mp->pool_size| supresses all overflow tests. - -The compaction process starts with |last_fixed_str| because all lower numbered -strings are permanently allocated with |max_str_ref| in their |str_ref| entries. - -@<Glob...@>= -str_number last_fixed_str; /* last permanently allocated string */ -str_number fixed_str_use; /* number of permanently allocated strings */ - -@ @<Internal library ...@>= -void mp_do_compaction (MP mp, pool_pointer needed) ; - -@ @c -void mp_do_compaction (MP mp, pool_pointer needed) { - str_number str_use; /* a count of strings in use */ - str_number r,s,t; /* strings being manipulated */ - pool_pointer p,q; /* destination and source for copying string characters */ - @<Advance |last_fixed_str| as far as possible and set |str_use|@>; - r=mp->last_fixed_str; - s=mp->next_str[r]; - p=mp->str_start[s]; - while ( s!=mp->str_ptr ) { - while ( mp->str_ref[s]==0 ) { - @<Advance |s| and add the old |s| to the list of free string numbers; - then |break| if |s=str_ptr|@>; - } - r=s; s=mp->next_str[s]; - incr(str_use); - @<Move string |r| back so that |str_start[r]=p|; make |p| the location - after the end of the string@>; - } -DONE: - @<Move the current string back so that it starts at |p|@>; - if ( needed<mp->pool_size ) { - @<Make sure that there is room for another string with |needed| characters@>; - } - @<Account for the compaction and make sure the statistics agree with the - global versions@>; - mp->strs_used_up=str_use; -} - -@ @<Advance |last_fixed_str| as far as possible and set |str_use|@>= -t=mp->next_str[mp->last_fixed_str]; -while (t!=mp->str_ptr && mp->str_ref[t]==max_str_ref) { - incr(mp->fixed_str_use); - mp->last_fixed_str=t; - t=mp->next_str[t]; -} -str_use=mp->fixed_str_use - -@ Because of the way |flush_string| has been written, it should never be -necessary to |break| here. The extra line of code seems worthwhile to -preserve the generality of |do_compaction|. - -@<Advance |s| and add the old |s| to the list of free string numbers;...@>= -{ -t=s; -s=mp->next_str[s]; -mp->next_str[r]=s; -mp->next_str[t]=mp->next_str[mp->str_ptr]; -mp->next_str[mp->str_ptr]=t; -if ( s==mp->str_ptr ) goto DONE; -} - -@ The string currently starts at |str_start[r]| and ends just before -|str_start[s]|. We don't change |str_start[s]| because it might be needed -to locate the next string. - -@<Move string |r| back so that |str_start[r]=p|; make |p| the location...@>= -q=mp->str_start[r]; -mp->str_start[r]=p; -while ( q<mp->str_start[s] ) { - mp->str_pool[p]=mp->str_pool[q]; - incr(p); incr(q); -} - -@ Pointers |str_start[str_ptr]| and |pool_ptr| have not been updated. When -we do this, anything between them should be moved. - -@ @<Move the current string back so that it starts at |p|@>= -q=mp->str_start[mp->str_ptr]; -mp->str_start[mp->str_ptr]=p; -while ( q<mp->pool_ptr ) { - mp->str_pool[p]=mp->str_pool[q]; - incr(p); incr(q); -} -mp->pool_ptr=p - -@ We must remember that |str_ptr| is not allowed to reach |mp->max_strings|. - -@<Make sure that there is room for another string with |needed| char...@>= -if ( str_use>=mp->max_strings-1 ) - mp_reallocate_strings (mp,str_use); -if ( mp->pool_ptr+needed>mp->max_pool_ptr ) { - mp_reallocate_pool(mp, mp->pool_ptr+needed); - mp->max_pool_ptr=mp->pool_ptr+needed; -} - -@ @<Internal library ...@>= -void mp_reallocate_strings (MP mp, str_number str_use) ; -void mp_reallocate_pool(MP mp, pool_pointer needed) ; - -@ @c -void mp_reallocate_strings (MP mp, str_number str_use) { - while ( str_use>=mp->max_strings-1 ) { - int l = mp->max_strings + (mp->max_strings/4); - XREALLOC (mp->str_ref, l, int); - XREALLOC (mp->str_start, l, pool_pointer); - XREALLOC (mp->next_str, l, str_number); - mp->max_strings = l; - } -} -void mp_reallocate_pool(MP mp, pool_pointer needed) { - while ( needed>mp->pool_size ) { - int l = mp->pool_size + (mp->pool_size/4); - XREALLOC (mp->str_pool, l, ASCII_code); - mp->pool_size = l; - } -} - -@ @<Account for the compaction and make sure the statistics agree with...@>= -if ( (mp->str_start[mp->str_ptr]!=mp->pool_in_use)||(str_use!=mp->strs_in_use) ) - mp_confusion(mp, "string"); -@:this can't happen string}{\quad string@> -incr(mp->pact_count); -mp->pact_chars=mp->pact_chars+mp->pool_ptr-str_stop(mp->last_fixed_str); -mp->pact_strs=mp->pact_strs+str_use-mp->fixed_str_use; - -@ A few more global variables are needed to keep track of statistics when -|stat| $\ldots$ |tats| blocks are not commented out. - -@<Glob...@>= -integer pact_count; /* number of string pool compactions so far */ -integer pact_chars; /* total number of characters moved during compactions */ -integer pact_strs; /* total number of strings moved during compactions */ - -@ @<Initialize compaction statistics@>= -mp->pact_count=0; -mp->pact_chars=0; -mp->pact_strs=0; - -@ The following subroutine compares string |s| with another string of the -same length that appears in |buffer| starting at position |k|; -the result is |true| if and only if the strings are equal. - -@c -static boolean mp_str_eq_buf (MP mp,str_number s, integer k) { - /* test equality of strings */ - pool_pointer j; /* running index */ - j=mp->str_start[s]; - while ( j<str_stop(s) ) { - if ( mp->str_pool[j++]!=mp->buffer[k++] ) - return false; - } - return true; -} - -@ Here is a similar routine, but it compares two strings in the string pool, -and it does not assume that they have the same length. If the first string -is lexicographically greater than, less than, or equal to the second, -the result is respectively positive, negative, or zero. - -@c -static integer mp_str_vs_str (MP mp, str_number s, str_number t) { - /* test equality of strings */ - pool_pointer j,k; /* running indices */ - integer ls,lt; /* lengths */ - integer l; /* length remaining to test */ - ls=length(s); lt=length(t); - if ( ls<=lt ) l=ls; else l=lt; - j=mp->str_start[s]; k=mp->str_start[t]; - while ( l-->0 ) { - if ( mp->str_pool[j]!=mp->str_pool[k] ) { - return (mp->str_pool[j]-mp->str_pool[k]); - } - j++; k++; - } - return (ls-lt); -} - -@ The initial values of |str_pool|, |str_start|, |pool_ptr|, -and |str_ptr| are computed by the \.{INIMP} program, based in part -on the information that \.{WEB} has output while processing \MP. -@.INIMP@> -@^string pool@> - -@c -void mp_get_strings_started (MP mp) { - /* initializes the string pool, - but returns |false| if something goes wrong */ - int k; /* small indices or counters */ - str_number g; /* a new string */ - mp->pool_ptr=0; mp->str_ptr=0; mp->max_pool_ptr=0; mp->max_str_ptr=0; - mp->str_start[0]=0; - mp->next_str[0]=1; - mp->pool_in_use=0; mp->strs_in_use=0; - mp->max_pl_used=0; mp->max_strs_used=0; - @<Initialize compaction statistics@>; - mp->strs_used_up=0; - @<Make the first 256 strings@>; - g=mp_make_string(mp); /* string 256 == "" */ - mp->str_ref[g]=max_str_ref; - mp->last_fixed_str=mp->str_ptr-1; - mp->fixed_str_use=mp->str_ptr; - return; -} - -@ @<Declarations@>= -static void mp_get_strings_started (MP mp); - -@ The first 256 strings will consist of a single character only. - -@<Make the first 256...@>= -for (k=0;k<=255;k++) { - append_char(k); - g=mp_make_string(mp); - mp->str_ref[g]=max_str_ref; -} - -@ The first 128 strings will contain 95 standard ASCII characters, and the -other 33 characters will be printed in three-symbol form like `\.{\^\^A}' -unless a system-dependent change is made here. Installations that have -an extended character set, where for example |xchr[032]=@t\.{'^^Z'}@>|, -would like string 032 to be printed as the single character 032 instead -of the three characters 0136, 0136, 0132 (\.{\^\^Z}). On the other hand, -even people with an extended character set will want to represent string -015 by \.{\^\^M}, since 015 is ASCII's ``carriage return'' code; the idea is -to produce visible strings instead of tabs or line-feeds or carriage-returns -or bell-rings or characters that are treated anomalously in text files. - -The boolean expression defined here should be |true| unless \MP\ internal -code number~|k| corresponds to a non-troublesome visible symbol in the -local character set. -If character |k| cannot be printed, and |k<0200|, then character |k+0100| or -|k-0100| must be printable; moreover, ASCII codes |[060..071, 0141..0146]| -must be printable. -@^character set dependencies@> -@^system dependencies@> - -@<Character |k| cannot be printed@>= - (k<' ')||(k==127) - -@* \[5] On-line and off-line printing. -Messages that are sent to a user's terminal and to the transcript-log file -are produced by several `|print|' procedures. These procedures will -direct their output to a variety of places, based on the setting of -the global variable |selector|, which has the following possible -values: - -\yskip -\hang |term_and_log|, the normal setting, prints on the terminal and on the - transcript file. - -\hang |log_only|, prints only on the transcript file. - -\hang |term_only|, prints only on the terminal. - -\hang |no_print|, doesn't print at all. This is used only in rare cases - before the transcript file is open. - -\hang |pseudo|, puts output into a cyclic buffer that is used - by the |show_context| routine; when we get to that routine we shall discuss - the reasoning behind this curious mode. - -\hang |new_string|, appends the output to the current string in the - string pool. - -\hang |>=write_file| prints on one of the files used for the \&{write} -@:write_}{\&{write} primitive@> - command. - -\yskip -\noindent The symbolic names `|term_and_log|', etc., have been assigned -numeric codes that satisfy the convenient relations |no_print+1=term_only|, -|no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|. These -relations are not used when |selector| could be |pseudo|, or |new_string|. -We need not check for unprintable characters when |selector<pseudo|. - -Three additional global variables, |tally|, |term_offset| and |file_offset| -record the number of characters that have been printed -since they were most recently cleared to zero. We use |tally| to record -the length of (possibly very long) stretches of printing; |term_offset|, -and |file_offset|, on the other hand, keep track of how many -characters have appeared so far on the current line that has been output -to the terminal, the transcript file, or the \ps\ output file, respectively. - -@d new_string 0 /* printing is deflected to the string pool */ -@d pseudo 2 /* special |selector| setting for |show_context| */ -@d no_print 3 /* |selector| setting that makes data disappear */ -@d term_only 4 /* printing is destined for the terminal only */ -@d log_only 5 /* printing is destined for the transcript file only */ -@d term_and_log 6 /* normal |selector| setting */ -@d write_file 7 /* first write file selector */ - -@<Glob...@>= -void * log_file; /* transcript of \MP\ session */ -void * ps_file; /* the generic font output goes here */ -unsigned int selector; /* where to print a message */ -unsigned char dig[23]; /* digits in a number, for rounding */ -integer tally; /* the number of characters recently printed */ -unsigned int term_offset; - /* the number of characters on the current terminal line */ -unsigned int file_offset; - /* the number of characters on the current file line */ -ASCII_code *trick_buf; /* circular buffer for pseudoprinting */ -integer trick_count; /* threshold for pseudoprinting, explained later */ -integer first_count; /* another variable for pseudoprinting */ - -@ @<Allocate or initialize ...@>= -mp->trick_buf = xmalloc((mp->error_line+1),sizeof(ASCII_code)); - -@ @<Dealloc variables@>= -xfree(mp->trick_buf); - -@ @<Initialize the output routines@>= -mp->selector=term_only; mp->tally=0; mp->term_offset=0; mp->file_offset=0; - -@ Macro abbreviations for output to the terminal and to the log file are -defined here for convenience. Some systems need special conventions -for terminal output, and it is possible to adhere to those conventions -by changing |wterm|, |wterm_ln|, and |wterm_cr| here. -@^system dependencies@> - -@(mpmp.h@>= -#define do_fprintf(f,b) (mp->write_ascii_file)(mp,f,b) -#define wterm(A) do_fprintf(mp->term_out,(A)) -#define wterm_chr(A) { unsigned char ss[2]; ss[0]=(A); ss[1]='\0'; wterm((char *)ss);} -#define wterm_cr do_fprintf(mp->term_out,"\n") -#define wterm_ln(A) { wterm_cr; do_fprintf(mp->term_out,(A)); } -#define wlog(A) do_fprintf(mp->log_file,(A)) -#define wlog_chr(A) { unsigned char ss[2]; ss[0]=(A); ss[1]='\0'; wlog((char *)ss);} -#define wlog_cr do_fprintf(mp->log_file, "\n") -#define wlog_ln(A) { wlog_cr; do_fprintf(mp->log_file,(A)); } - - -@ To end a line of text output, we call |print_ln|. Cases |0..max_write_files| -use an array |wr_file| that will be declared later. - -@d mp_print_text(A) mp_print_str(mp,text((A))) - -@<Internal library ...@>= -void mp_print (MP mp, const char *s); -void mp_print_ln (MP mp); -void mp_print_visible_char (MP mp, ASCII_code s); -void mp_print_char (MP mp, ASCII_code k); -void mp_print_str (MP mp, str_number s); -void mp_print_nl (MP mp, const char *s); -void mp_print_two (MP mp,scaled x, scaled y) ; -void mp_print_scaled (MP mp,scaled s); - -@ @<Basic print...@>= -void mp_print_ln (MP mp) { /* prints an end-of-line */ - switch (mp->selector) { - case term_and_log: - wterm_cr; wlog_cr; - mp->term_offset=0; mp->file_offset=0; - break; - case log_only: - wlog_cr; mp->file_offset=0; - break; - case term_only: - wterm_cr; mp->term_offset=0; - break; - case no_print: - case pseudo: - case new_string: - break; - default: - do_fprintf(mp->wr_file[(mp->selector-write_file)],"\n"); - } -} /* note that |tally| is not affected */ - -@ The |print_visible_char| procedure sends one character to the desired -destination, using the |xchr| array to map it into an external character -compatible with |input_ln|. (It assumes that it is always called with -a visible ASCII character.) All printing comes through |print_ln| or -|print_char|, which ultimately calls |print_visible_char|, hence these -routines are the ones that limit lines to at most |max_print_line| characters. -But we must make an exception for the \ps\ output file since it is not safe -to cut up lines arbitrarily in \ps. - -Procedure |unit_str_room| needs to be declared |forward| here because it calls -|do_compaction| and |do_compaction| can call the error routines. Actually, -|unit_str_room| avoids |overflow| errors but it can call |confusion|. - -@<Basic printing...@>= -void mp_print_visible_char (MP mp, ASCII_code s) { /* prints a single character */ - switch (mp->selector) { - case term_and_log: - wterm_chr(xchr(s)); wlog_chr(xchr(s)); - incr(mp->term_offset); incr(mp->file_offset); - if ( mp->term_offset==(unsigned)mp->max_print_line ) { - wterm_cr; mp->term_offset=0; - }; - if ( mp->file_offset==(unsigned)mp->max_print_line ) { - wlog_cr; mp->file_offset=0; - }; - break; - case log_only: - wlog_chr(xchr(s)); incr(mp->file_offset); - if ( mp->file_offset==(unsigned)mp->max_print_line ) mp_print_ln(mp); - break; - case term_only: - wterm_chr(xchr(s)); incr(mp->term_offset); - if ( mp->term_offset==(unsigned)mp->max_print_line ) mp_print_ln(mp); - break; - case no_print: - break; - case pseudo: - if ( mp->tally<mp->trick_count ) - mp->trick_buf[mp->tally % mp->error_line]=s; - break; - case new_string: - if (mp->pool_ptr>=mp->pool_size || mp->pool_ptr>=mp->max_pool_ptr ) { - mp_unit_str_room(mp); - if ( mp->pool_ptr>=mp->pool_size ) - goto DONE; /* drop characters if string space is full */ - }; - append_char(s); - break; - default: - { text_char ss[2]; ss[0] = xchr(s); ss[1]=0; - do_fprintf(mp->wr_file[(mp->selector-write_file)],(char *)ss); - } - } -DONE: - incr(mp->tally); -} - -@ The |print_char| procedure sends one character to the desired destination. -File names and string expressions might contain |ASCII_code| values that -can't be printed using |print_visible_char|. These characters will be -printed in three- or four-symbol form like `\.{\^\^A}' or `\.{\^\^e4}'. -(This procedure assumes that it is safe to bypass all checks for unprintable -characters when |selector| is in the range |0..max_write_files-1|. -The user might want to write unprintable characters. - -@<Basic printing...@>= -void mp_print_char (MP mp, ASCII_code k) { /* prints a single character */ - if ( mp->selector<pseudo || mp->selector>=write_file) { - mp_print_visible_char(mp, k); - } else if ( @<Character |k| cannot be printed@> ) { - mp_print(mp, "^^"); - if ( k<0100 ) { - mp_print_visible_char(mp, k+0100); - } else if ( k<0200 ) { - mp_print_visible_char(mp, k-0100); - } else { - int l; /* small index or counter */ - l = (k / 16); - mp_print_visible_char(mp, xord(l<10 ? l+'0' : l-10+'a')); - l = (k % 16); - mp_print_visible_char(mp, xord(l<10 ? l+'0' : l-10+'a')); - } - } else { - mp_print_visible_char(mp, k); - } -} - -@ An entire string is output by calling |print|. Note that if we are outputting -the single standard ASCII character \.c, we could call |print("c")|, since -|"c"=99| is the number of a single-character string, as explained above. But -|print_char("c")| is quicker, so \MP\ goes directly to the |print_char| -routine when it knows that this is safe. (The present implementation -assumes that it is always safe to print a visible ASCII character.) -@^system dependencies@> - -@<Basic print...@>= -static void mp_do_print (MP mp, const char *ss, size_t len) { /* prints string |s| */ - size_t j = 0; - if (mp->selector == new_string) { - str_room((integer)(len*4)); - } - while ( j<len ){ - /* this was |xord((int)ss[j])| but that doesnt work */ - mp_print_char(mp, (ASCII_code)ss[j]); j++; - } -} - -@ -@<Basic print...@>= -void mp_print (MP mp, const char *ss) { - if (ss==NULL) return; - mp_do_print(mp, ss,strlen(ss)); -} -void mp_print_str (MP mp, str_number s) { - pool_pointer j; /* current character code position */ - if ( (s<0)||(s>mp->max_str_ptr) ) { - mp_do_print(mp,"???",3); /* this can't happen */ -@.???@> - } - j=mp->str_start[s]; - mp_do_print(mp, (char *)(mp->str_pool+j), (size_t)(str_stop(s)-j)); -} - - -@ Here is the very first thing that \MP\ prints: a headline that identifies -the version number and base name. The |term_offset| variable is temporarily -incorrect, but the discrepancy is not serious since we assume that the banner -and mem identifier together will occupy at most |max_print_line| -character positions. - -@<Initialize the output...@>= -wterm (mp->banner); -if (mp->mem_ident!=NULL) - mp_print(mp,mp->mem_ident); -mp_print_ln(mp); -update_terminal; - -@ The procedure |print_nl| is like |print|, but it makes sure that the -string appears at the beginning of a new line. - -@<Basic print...@>= -void mp_print_nl (MP mp, const char *s) { /* prints string |s| at beginning of line */ - switch(mp->selector) { - case term_and_log: - if ( (mp->term_offset>0)||(mp->file_offset>0) ) mp_print_ln(mp); - break; - case log_only: - if ( mp->file_offset>0 ) mp_print_ln(mp); - break; - case term_only: - if ( mp->term_offset>0 ) mp_print_ln(mp); - break; - case no_print: - case pseudo: - case new_string: - break; - } /* there are no other cases */ - mp_print(mp, s); -} - -@ The following procedure, which prints out the decimal representation of a -given integer |n|, assumes that all integers fit nicely into a |int|. -@^system dependencies@> - -@<Basic print...@>= -void mp_print_int (MP mp,integer n) { /* prints an integer in decimal form */ - char s[12]; - mp_snprintf(s,12,"%d", (int)n); - mp_print(mp,s); -} - -@ @<Internal library ...@>= -void mp_print_int (MP mp,integer n); - -@ \MP\ also makes use of a trivial procedure to print two digits. The -following subroutine is usually called with a parameter in the range |0<=n<=99|. - -@c -static void mp_print_dd (MP mp,integer n) { /* prints two least significant digits */ - n=abs(n) % 100; - mp_print_char(mp, xord('0'+(n / 10))); - mp_print_char(mp, xord('0'+(n % 10))); -} - - -@ @<Declarations@>= -static void mp_print_dd (MP mp,integer n); - -@ Here is a procedure that asks the user to type a line of input, -assuming that the |selector| setting is either |term_only| or |term_and_log|. -The input is placed into locations |first| through |last-1| of the -|buffer| array, and echoed on the transcript file if appropriate. - -This procedure is never called when |interaction<mp_scroll_mode|. - -@d prompt_input(A) do { - if (!mp->noninteractive) { - wake_up_terminal; mp_print(mp, (A)); - } - mp_term_input(mp); - } while (0) /* prints a string and gets a line of input */ - -@c -void mp_term_input (MP mp) { /* gets a line from the terminal */ - size_t k; /* index into |buffer| */ - if (mp->noninteractive) { - if (!mp_input_ln(mp, mp->term_in )) - longjmp(*(mp->jump_buf),1); /* chunk finished */ - mp->buffer[mp->last]=xord('%'); - } else { - update_terminal; /* Now the user sees the prompt for sure */ - if (!mp_input_ln(mp, mp->term_in )) { - mp_fatal_error(mp, "End of file on the terminal!"); -@.End of file on the terminal@> - } - mp->term_offset=0; /* the user's line ended with \<\rm return> */ - decr(mp->selector); /* prepare to echo the input */ - if ( mp->last!=mp->first ) { - for (k=mp->first;k<mp->last;k++) { - mp_print_char(mp, mp->buffer[k]); - } - } - mp_print_ln(mp); - mp->buffer[mp->last]=xord('%'); - incr(mp->selector); /* restore previous status */ - } -} - -@* \[6] Reporting errors. -When something anomalous is detected, \MP\ typically does something like this: -$$\vbox{\halign{#\hfil\cr -|print_err("Something anomalous has been detected");|\cr -|help3("This is the first line of my offer to help.")|\cr -|("This is the second line. I'm trying to")|\cr -|("explain the best way for you to proceed.");|\cr -|error;|\cr}}$$ -A two-line help message would be given using |help2|, etc.; these informal -helps should use simple vocabulary that complements the words used in the -official error message that was printed. (Outside the U.S.A., the help -messages should preferably be translated into the local vernacular. Each -line of help is at most 60 characters long, in the present implementation, -so that |max_print_line| will not be exceeded.) - -The |print_err| procedure supplies a `\.!' before the official message, -and makes sure that the terminal is awake if a stop is going to occur. -The |error| procedure supplies a `\..' after the official message, then it -shows the location of the error; and if |interaction=error_stop_mode|, -it also enters into a dialog with the user, during which time the help -message may be printed. -@^system dependencies@> - -@ The global variable |interaction| has four settings, representing increasing -amounts of user interaction: - -@<Exported types@>= -enum mp_interaction_mode { - mp_unspecified_mode=0, /* extra value for command-line switch */ - mp_batch_mode, /* omits all stops and omits terminal output */ - mp_nonstop_mode, /* omits all stops */ - mp_scroll_mode, /* omits error stops */ - mp_error_stop_mode /* stops at every opportunity to interact */ -}; - -@ @<Option variables@>= -int interaction; /* current level of interaction */ -int noninteractive; /* do we have a terminal? */ - -@ Set it here so it can be overwritten by the commandline - -@<Allocate or initialize ...@>= -mp->interaction=opt->interaction; -if (mp->interaction==mp_unspecified_mode || mp->interaction>mp_error_stop_mode) - mp->interaction=mp_error_stop_mode; -if (mp->interaction<mp_unspecified_mode) - mp->interaction=mp_batch_mode; - -@ - -@d print_err(A) mp_print_err(mp,(A)) - -@<Internal ...@>= -void mp_print_err(MP mp, const char * A); - -@ @c -void mp_print_err(MP mp, const char * A) { - if ( mp->interaction==mp_error_stop_mode ) - wake_up_terminal; - if (mp->file_line_error_style && file_state && !terminal_input) { - mp_print_nl(mp, ""); - if (mp->long_name != NULL) { - mp_print(mp, mp->long_name); - } else { - mp_print(mp, mp_str(mp,name)); - } - mp_print(mp, ":"); - mp_print_int(mp, line); - mp_print(mp, ": "); - } else{ - mp_print_nl(mp, "! "); - } - mp_print(mp, A); -@.!\relax@> -} - - -@ \MP\ is careful not to call |error| when the print |selector| setting -might be unusual. The only possible values of |selector| at the time of -error messages are - -\yskip\hang|no_print| (when |interaction=mp_batch_mode| - and |log_file| not yet open); - -\hang|term_only| (when |interaction>mp_batch_mode| and |log_file| not yet open); - -\hang|log_only| (when |interaction=mp_batch_mode| and |log_file| is open); - -\hang|term_and_log| (when |interaction>mp_batch_mode| and |log_file| is open). - -@<Initialize the print |selector| based on |interaction|@>= -if ( mp->interaction==mp_batch_mode ) mp->selector=no_print; else mp->selector=term_only - -@ A global variable |deletions_allowed| is set |false| if the |get_next| -routine is active when |error| is called; this ensures that |get_next| -will never be called recursively. -@^recursion@> - -The global variable |history| records the worst level of error that -has been detected. It has four possible values: |spotless|, |warning_issued|, -|error_message_issued|, and |fatal_error_stop|. - -Another global variable, |error_count|, is increased by one when an -|error| occurs without an interactive dialog, and it is reset to zero at -the end of every statement. If |error_count| reaches 100, \MP\ decides -that there is no point in continuing further. - -@<Exported types@>= -enum mp_history_state { - mp_spotless=0, /* |history| value when nothing has been amiss yet */ - mp_warning_issued, /* |history| value when |begin_diagnostic| has been called */ - mp_error_message_issued, /* |history| value when |error| has been called */ - mp_fatal_error_stop, /* |history| value when termination was premature */ - mp_system_error_stop /* |history| value when termination was due to disaster */ -}; - -@ @<Glob...@>= -boolean deletions_allowed; /* is it safe for |error| to call |get_next|? */ -int history; /* has the source input been clean so far? */ -int error_count; /* the number of scrolled errors since the last statement ended */ - -@ The value of |history| is initially |fatal_error_stop|, but it will -be changed to |spotless| if \MP\ survives the initialization process. - -@<Allocate or ...@>= -mp->deletions_allowed=true; /* |history| is initialized elsewhere */ - -@ Since errors can be detected almost anywhere in \MP, we want to declare the -error procedures near the beginning of the program. But the error procedures -in turn use some other procedures, which need to be declared |forward| -before we get to |error| itself. - -It is possible for |error| to be called recursively if some error arises -when |get_next| is being used to delete a token, and/or if some fatal error -occurs while \MP\ is trying to fix a non-fatal one. But such recursion -@^recursion@> -is never more than two levels deep. - -@<Declarations@>= -static void mp_get_next (MP mp); -static void mp_term_input (MP mp); -static void mp_show_context (MP mp); -static void mp_begin_file_reading (MP mp); -static void mp_open_log_file (MP mp); -static void mp_clear_for_error_prompt (MP mp); - -@ @<Internal ...@>= -void mp_normalize_selector (MP mp); - -@ Individual lines of help are recorded in the array |help_line|, which -contains entries in positions |0..(help_ptr-1)|. They should be printed -in reverse order, i.e., with |help_line[0]| appearing last. - -@d hlp1(A) mp->help_line[0]=A; } -@d hlp2(A,B) mp->help_line[1]=A; hlp1(B) -@d hlp3(A,B,C) mp->help_line[2]=A; hlp2(B,C) -@d hlp4(A,B,C,D) mp->help_line[3]=A; hlp3(B,C,D) -@d hlp5(A,B,C,D,E) mp->help_line[4]=A; hlp4(B,C,D,E) -@d hlp6(A,B,C,D,E,F) mp->help_line[5]=A; hlp5(B,C,D,E,F) -@d help0 mp->help_ptr=0 /* sometimes there might be no help */ -@d help1 { mp->help_ptr=1; hlp1 /* use this with one help line */ -@d help2 { mp->help_ptr=2; hlp2 /* use this with two help lines */ -@d help3 { mp->help_ptr=3; hlp3 /* use this with three help lines */ -@d help4 { mp->help_ptr=4; hlp4 /* use this with four help lines */ -@d help5 { mp->help_ptr=5; hlp5 /* use this with five help lines */ -@d help6 { mp->help_ptr=6; hlp6 /* use this with six help lines */ - -@<Glob...@>= -const char * help_line[6]; /* helps for the next |error| */ -unsigned int help_ptr; /* the number of help lines present */ -boolean use_err_help; /* should the |err_help| string be shown? */ -str_number err_help; /* a string set up by \&{errhelp} */ -str_number filename_template; /* a string set up by \&{filenametemplate} */ - -@ @<Allocate or ...@>= -mp->use_err_help=false; - -@ The |jump_out| procedure just cuts across all active procedure levels and -goes to |end_of_MP|. This is the only nonlocal |goto| statement in the -whole program. It is used when there is no recovery from a particular error. - -The program uses a |jump_buf| to handle this, this is initialized at three -spots: the start of |mp_new|, the start of |mp_initialize|, and the start -of |mp_run|. Those are the only library enty points. - -@^system dependencies@> - -@<Glob...@>= -jmp_buf *jump_buf; - -@ If the array of internals is still |NULL| when |jump_out| is called, a -crash occured during initialization, and it is not safe to run the normal -cleanup routine. - -@<Error hand...@>= -static void mp_jump_out (MP mp) { - if (mp->internal!=NULL && mp->history < mp_system_error_stop) - mp_close_files_and_terminate(mp); - longjmp(*(mp->jump_buf),1); -} - -@ Here now is the general |error| routine. - -@<Error hand...@>= -void mp_error (MP mp) { /* completes the job of error reporting */ - ASCII_code c; /* what the user types */ - integer s1,s2,s3; /* used to save global variables when deleting tokens */ - pool_pointer j; /* character position being printed */ - if ( mp->history<mp_error_message_issued ) - mp->history=mp_error_message_issued; - mp_print_char(mp, xord('.')); mp_show_context(mp); - if ((!mp->noninteractive) && (mp->interaction==mp_error_stop_mode )) { - @<Get user's advice and |return|@>; - } - incr(mp->error_count); - if ( mp->error_count==100 ) { - mp_print_nl(mp,"(That makes 100 errors; please try again.)"); -@.That makes 100 errors...@> - mp->history=mp_fatal_error_stop; mp_jump_out(mp); - } - @<Put help message on the transcript file@>; -} -void mp_warn (MP mp, const char *msg) { - unsigned saved_selector = mp->selector; - mp_normalize_selector(mp); - mp_print_nl(mp,"Warning: "); - mp_print(mp,msg); - mp_print_ln(mp); - mp->selector = saved_selector; -} - -@ @<Exported function ...@>= -extern void mp_error (MP mp); -extern void mp_warn (MP mp, const char *msg); - - -@ @<Get user's advice...@>= -while (true) { -CONTINUE: - mp_clear_for_error_prompt(mp); prompt_input("? "); -@.?\relax@> - if ( mp->last==mp->first ) return; - c=mp->buffer[mp->first]; - if ( c>='a' ) c=c+'A'-'a'; /* convert to uppercase */ - @<Interpret code |c| and |return| if done@>; -} - -@ It is desirable to provide an `\.E' option here that gives the user -an easy way to return from \MP\ to the system editor, with the offending -line ready to be edited. But such an extension requires some system -wizardry, so the present implementation simply types out the name of the -file that should be -edited and the relevant line number. -@^system dependencies@> - -@<Exported types@>= -typedef void (*mp_editor_cmd)(MP, char *, int); - -@ @<Option variables@>= -mp_editor_cmd run_editor; - -@ @<Allocate or initialize ...@>= -set_callback_option(run_editor); - -@ @<Declarations@>= -static void mp_run_editor (MP mp, char *fname, int fline); - -@ @c -void mp_run_editor (MP mp, char *fname, int fline) { - char *s = xmalloc(256,1); - mp_snprintf(s, 256,"You want to edit file %s at line %d\n", fname, fline); - wterm_ln(s); -@.You want to edit file x@> -} - -@ -There is a secret `\.D' option available when the debugging routines haven't -been commented~out. -@^debugging@> - -@<Interpret code |c| and |return| if done@>= -switch (c) { -case '0': case '1': case '2': case '3': case '4': -case '5': case '6': case '7': case '8': case '9': - if ( mp->deletions_allowed ) { - @<Delete |c-"0"| tokens and |continue|@>; - } - break; -case 'E': - if ( mp->file_ptr>0 ){ - mp->interaction=mp_scroll_mode; - mp_close_files_and_terminate(mp); - (mp->run_editor)(mp, - str(mp->input_stack[mp->file_ptr].name_field), - mp_true_line(mp)); - mp_jump_out(mp); - } - break; -case 'H': - @<Print the help information and |continue|@>; - /* |break;| */ -case 'I': - @<Introduce new material from the terminal and |return|@>; - /* |break;| */ -case 'Q': case 'R': case 'S': - @<Change the interaction level and |return|@>; - /* |break;| */ -case 'X': - mp->interaction=mp_scroll_mode; mp_jump_out(mp); - break; -default: - break; -} -@<Print the menu of available options@> - -@ @<Print the menu...@>= -{ - mp_print(mp, "Type <return> to proceed, S to scroll future error messages,"); -@.Type <return> to proceed...@> - mp_print_nl(mp, "R to run without stopping, Q to run quietly,"); - mp_print_nl(mp, "I to insert something, "); - if ( mp->file_ptr>0 ) - mp_print(mp, "E to edit your file,"); - if ( mp->deletions_allowed ) - mp_print_nl(mp, "1 or ... or 9 to ignore the next 1 to 9 tokens of input,"); - mp_print_nl(mp, "H for help, X to quit."); -} - -@ Here the author of \MP\ apologizes for making use of the numerical -relation between |"Q"|, |"R"|, |"S"|, and the desired interaction settings -|mp_batch_mode|, |mp_nonstop_mode|, |mp_scroll_mode|. -@^Knuth, Donald Ervin@> - -@<Change the interaction...@>= -{ - mp->error_count=0; mp->interaction=mp_batch_mode+c-'Q'; - mp_print(mp, "OK, entering "); - switch (c) { - case 'Q': mp_print(mp, "batchmode"); decr(mp->selector); break; - case 'R': mp_print(mp, "nonstopmode"); break; - case 'S': mp_print(mp, "scrollmode"); break; - } /* there are no other cases */ - mp_print(mp, "..."); mp_print_ln(mp); update_terminal; return; -} - -@ When the following code is executed, |buffer[(first+1)..(last-1)]| may -contain the material inserted by the user; otherwise another prompt will -be given. In order to understand this part of the program fully, you need -to be familiar with \MP's input stacks. - -@<Introduce new material...@>= -{ - mp_begin_file_reading(mp); /* enter a new syntactic level for terminal input */ - if ( mp->last>mp->first+1 ) { - loc=(halfword)(mp->first+1); mp->buffer[mp->first]=xord(' '); - } else { - prompt_input("insert>"); loc=(halfword)mp->first; -@.insert>@> - }; - mp->first=mp->last+1; mp->cur_input.limit_field=(halfword)mp->last; return; -} - -@ We allow deletion of up to 99 tokens at a time. - -@<Delete |c-"0"| tokens...@>= -{ - s1=mp->cur_cmd; s2=mp->cur_mod; s3=mp->cur_sym; mp->OK_to_interrupt=false; - if ( (mp->last>mp->first+1) && (mp->buffer[mp->first+1]>='0')&&(mp->buffer[mp->first+1]<='9') ) - c=xord(c*10+mp->buffer[mp->first+1]-'0'*11); - else - c=c-'0'; - while ( c>0 ) { - mp_get_next(mp); /* one-level recursive call of |error| is possible */ - @<Decrease the string reference count, if the current token is a string@>; - decr(c); - }; - mp->cur_cmd=s1; mp->cur_mod=s2; mp->cur_sym=s3; mp->OK_to_interrupt=true; - help2("I have just deleted some text, as you asked.", - "You can now delete more, or insert, or whatever."); - mp_show_context(mp); - goto CONTINUE; -} - -@ @<Print the help info...@>= -{ - if ( mp->use_err_help ) { - @<Print the string |err_help|, possibly on several lines@>; - mp->use_err_help=false; - } else { - if ( mp->help_ptr==0 ) { - help2("Sorry, I don't know how to help in this situation.", - "Maybe you should try asking a human?"); - } - do { - decr(mp->help_ptr); mp_print(mp, mp->help_line[mp->help_ptr]); mp_print_ln(mp); - } while (mp->help_ptr!=0); - }; - help4("Sorry, I already gave what help I could...", - "Maybe you should try asking a human?", - "An error might have occurred before I noticed any problems.", - "``If all else fails, read the instructions.''"); - goto CONTINUE; -} - -@ @<Print the string |err_help|, possibly on several lines@>= -j=mp->str_start[mp->err_help]; -while ( j<str_stop(mp->err_help) ) { - if ( mp->str_pool[j]!='%' ) mp_print_str(mp, mp->str_pool[j]); - else if ( j+1==str_stop(mp->err_help) ) mp_print_ln(mp); - else if ( mp->str_pool[j+1]!='%' ) mp_print_ln(mp); - else { j++; mp_print_char(mp, xord('%')); }; - j++; -} - -@ @<Put help message on the transcript file@>= -if ( mp->interaction>mp_batch_mode ) decr(mp->selector); /* avoid terminal output */ -if ( mp->use_err_help ) { - mp_print_nl(mp, ""); - @<Print the string |err_help|, possibly on several lines@>; -} else { - while ( mp->help_ptr>0 ){ - decr(mp->help_ptr); mp_print_nl(mp, mp->help_line[mp->help_ptr]); - }; -} -mp_print_ln(mp); -if ( mp->interaction>mp_batch_mode ) incr(mp->selector); /* re-enable terminal output */ -mp_print_ln(mp) - -@ In anomalous cases, the print selector might be in an unknown state; -the following subroutine is called to fix things just enough to keep -running a bit longer. - -@c -void mp_normalize_selector (MP mp) { - if ( mp->log_opened ) mp->selector=term_and_log; - else mp->selector=term_only; - if ( mp->job_name==NULL) mp_open_log_file(mp); - if ( mp->interaction==mp_batch_mode ) decr(mp->selector); -} - -@ The following procedure prints \MP's last words before dying. - -@d succumb { if ( mp->interaction==mp_error_stop_mode ) - mp->interaction=mp_scroll_mode; /* no more interaction */ - if ( mp->log_opened ) mp_error(mp); - mp->history=mp_fatal_error_stop; mp_jump_out(mp); /* irrecoverable error */ - } - -@<Error hand...@>= -void mp_fatal_error (MP mp, const char *s) { /* prints |s|, and that's it */ - mp_normalize_selector(mp); - print_err("Emergency stop"); help1(s); succumb; -@.Emergency stop@> -} - -@ @<Exported function ...@>= -extern void mp_fatal_error (MP mp, const char *s); - - -@ Here is the most dreaded error message. - -@<Error hand...@>= -void mp_overflow (MP mp, const char *s, integer n) { /* stop due to finiteness */ - char msg[256]; - mp_normalize_selector(mp); - mp_snprintf(msg, 256, "MetaPost capacity exceeded, sorry [%s=%d]",s,(int)n); -@.MetaPost capacity exceeded ...@> - print_err(msg); - help2("If you really absolutely need more capacity,", - "you can ask a wizard to enlarge me."); - succumb; -} - -@ @<Internal library declarations@>= -void mp_overflow (MP mp, const char *s, integer n); - -@ The program might sometime run completely amok, at which point there is -no choice but to stop. If no previous error has been detected, that's bad -news; a message is printed that is really intended for the \MP\ -maintenance person instead of the user (unless the user has been -particularly diabolical). The index entries for `this can't happen' may -help to pinpoint the problem. -@^dry rot@> - -@<Internal library ...@>= -void mp_confusion (MP mp, const char *s); - -@ Consistency check violated; |s| tells where. -@<Error hand...@>= -void mp_confusion (MP mp, const char *s) { - char msg[256]; - mp_normalize_selector(mp); - if ( mp->history<mp_error_message_issued ) { - mp_snprintf(msg, 256, "This can't happen (%s)",s); -@.This can't happen@> - print_err(msg); - help1("I'm broken. Please show this to someone who can fix can fix"); - } else { - print_err("I can\'t go on meeting you like this"); -@.I can't go on...@> - help2("One of your faux pas seems to have wounded me deeply...", - "in fact, I'm barely conscious. Please fix it and try again."); - } - succumb; -} - -@ Users occasionally want to interrupt \MP\ while it's running. -If the runtime system allows this, one can implement -a routine that sets the global variable |interrupt| to some nonzero value -when such an interrupt is signaled. Otherwise there is probably at least -a way to make |interrupt| nonzero using the C debugger. -@^system dependencies@> -@^debugging@> - -@d check_interrupt { if ( mp->interrupt!=0 ) - mp_pause_for_instructions(mp); } - -@<Global...@>= -integer interrupt; /* should \MP\ pause for instructions? */ -boolean OK_to_interrupt; /* should interrupts be observed? */ -integer run_state; /* are we processing input ?*/ -boolean finished; /* set true by |close_files_and_terminate| */ - -@ @<Allocate or ...@>= -mp->OK_to_interrupt=true; -mp->finished=false; - -@ When an interrupt has been detected, the program goes into its -highest interaction level and lets the user have the full flexibility of -the |error| routine. \MP\ checks for interrupts only at times when it is -safe to do this. - -@c -static void mp_pause_for_instructions (MP mp) { - if ( mp->OK_to_interrupt ) { - mp->interaction=mp_error_stop_mode; - if ( (mp->selector==log_only)||(mp->selector==no_print) ) - incr(mp->selector); - print_err("Interruption"); -@.Interruption@> - help3("You rang?", - "Try to insert some instructions for me (e.g.,`I show x'),", - "unless you just want to quit by typing `X'."); - mp->deletions_allowed=false; mp_error(mp); mp->deletions_allowed=true; - mp->interrupt=0; - } -} - -@ Many of \MP's error messages state that a missing token has been -inserted behind the scenes. We can save string space and program space -by putting this common code into a subroutine. - -@c -static void mp_missing_err (MP mp, const char *s) { - char msg[256]; - mp_snprintf(msg, 256, "Missing `%s' has been inserted", s); -@.Missing...inserted@> - print_err(msg); -} - -@* \[7] Arithmetic with scaled numbers. -The principal computations performed by \MP\ are done entirely in terms of -integers less than $2^{31}$ in magnitude; thus, the arithmetic specified in this -program can be carried out in exactly the same way on a wide variety of -computers, including some small ones. -@^small computers@> - -But C does not rigidly define the |/| operation in the case of negative -dividends; for example, the result of |(-2*n-1) / 2| is |-(n+1)| on some -computers and |-n| on others (is this true ?). There are two principal -types of arithmetic: ``translation-preserving,'' in which the identity -|(a+q*b)/b=(a/b)+q| is valid; and ``negation-preserving,'' in which -|(-a)/b=-(a/b)|. This leads to two \MP s, which can produce -different results, although the differences should be negligible when the -language is being used properly. The \TeX\ processor has been defined -carefully so that both varieties of arithmetic will produce identical -output, but it would be too inefficient to constrain \MP\ in a similar way. - -@d el_gordo 0x7fffffff /* $2^{31}-1$, the largest value that \MP\ likes */ - - -@ One of \MP's most common operations is the calculation of -$\lfloor{a+b\over2}\rfloor$, -the midpoint of two given integers |a| and~|b|. The most decent way to do -this is to write `|(a+b)/2|'; but on many machines it is more efficient -to calculate `|(a+b)>>1|'. - -Therefore the midpoint operation will always be denoted by `|half(a+b)|' -in this program. If \MP\ is being implemented with languages that permit -binary shifting, the |half| macro should be changed to make this operation -as efficient as possible. Since some systems have shift operators that can -only be trusted to work on positive numbers, there is also a macro |halfp| -that is used only when the quantity being halved is known to be positive -or zero. - -@d half(A) ((A) / 2) -@d halfp(A) (integer)((unsigned)(A) >> 1) - -@ A single computation might use several subroutine calls, and it is -desirable to avoid producing multiple error messages in case of arithmetic -overflow. So the routines below set the global variable |arith_error| to |true| -instead of reporting errors directly to the user. -@^overflow in arithmetic@> - -@<Glob...@>= -boolean arith_error; /* has arithmetic overflow occurred recently? */ - -@ @<Allocate or ...@>= -mp->arith_error=false; - -@ At crucial points the program will say |check_arith|, to test if -an arithmetic error has been detected. - -@d check_arith { if ( mp->arith_error ) mp_clear_arith(mp); } - -@c -static void mp_clear_arith (MP mp) { - print_err("Arithmetic overflow"); -@.Arithmetic overflow@> - help4("Uh, oh. A little while ago one of the quantities that I was", - "computing got too large, so I'm afraid your answers will be", - "somewhat askew. You'll probably have to adopt different", - "tactics next time. But I shall try to carry on anyway."); - mp_error(mp); - mp->arith_error=false; -} - -@ Addition is not always checked to make sure that it doesn't overflow, -but in places where overflow isn't too unlikely the |slow_add| routine -is used. - -@c static integer mp_slow_add (MP mp,integer x, integer y) { - if ( x>=0 ) { - if ( y<=el_gordo-x ) { - return x+y; - } else { - mp->arith_error=true; - return el_gordo; - } - } else if ( -y<=el_gordo+x ) { - return x+y; - } else { - mp->arith_error=true; - return -el_gordo; - } -} - -@ Fixed-point arithmetic is done on {\sl scaled integers\/} that are multiples -of $2^{-16}$. In other words, a binary point is assumed to be sixteen bit -positions from the right end of a binary computer word. - -@d quarter_unit 040000 /* $2^{14}$, represents 0.250000 */ -@d half_unit 0100000 /* $2^{15}$, represents 0.50000 */ -@d three_quarter_unit 0140000 /* $3\cdot2^{14}$, represents 0.75000 */ -@d unity 0200000 /* $2^{16}$, represents 1.00000 */ -@d two 0400000 /* $2^{17}$, represents 2.00000 */ -@d three 0600000 /* $2^{17}+2^{16}$, represents 3.00000 */ - -@<Types...@>= -typedef integer scaled; /* this type is used for scaled integers */ - -@ The following function is used to create a scaled integer from a given decimal -fraction $(.d_0d_1\ldots d_{k-1})$, where |0<=k<=17|. The digit $d_i$ is -given in |dig[i]|, and the calculation produces a correctly rounded result. - -@c -static scaled mp_round_decimals (MP mp,quarterword k) { - /* converts a decimal fraction */ - unsigned a = 0; /* the accumulator */ - while ( k-->0 ) { - a=(a+mp->dig[k]*two) / 10; - } - return (scaled)halfp(a+1); -} - -@ Conversely, here is a procedure analogous to |print_int|. If the output -of this procedure is subsequently read by \MP\ and converted by the -|round_decimals| routine above, it turns out that the original value will -be reproduced exactly. A decimal point is printed only if the value is -not an integer. If there is more than one way to print the result with -the optimum number of digits following the decimal point, the closest -possible value is given. - -The invariant relation in the \&{repeat} loop is that a sequence of -decimal digits yet to be printed will yield the original number if and only if -they form a fraction~$f$ in the range $s-\delta\L10\cdot2^{16}f<s$. -We can stop if and only if $f=0$ satisfies this condition; the loop will -terminate before $s$ can possibly become zero. - -@<Basic printing...@>= -void mp_print_scaled (MP mp,scaled s) { /* prints scaled real, rounded to five digits */ - scaled delta; /* amount of allowable inaccuracy */ - if ( s<0 ) { - mp_print_char(mp, xord('-')); - negate(s); /* print the sign, if negative */ - } - mp_print_int(mp, s / unity); /* print the integer part */ - s=10*(s % unity)+5; - if ( s!=5 ) { - delta=10; - mp_print_char(mp, xord('.')); - do { - if ( delta>unity ) - s=s+0100000-(delta / 2); /* round the final digit */ - mp_print_char(mp, xord('0'+(s / unity))); - s=10*(s % unity); - delta=delta*10; - } while (s>delta); - } -} - -@ We often want to print two scaled quantities in parentheses, -separated by a comma. - -@<Basic printing...@>= -void mp_print_two (MP mp,scaled x, scaled y) { /* prints `|(x,y)|' */ - mp_print_char(mp, xord('(')); - mp_print_scaled(mp, x); - mp_print_char(mp, xord(',')); - mp_print_scaled(mp, y); - mp_print_char(mp, xord(')')); -} - -@ The |scaled| quantities in \MP\ programs are generally supposed to be -less than $2^{12}$ in absolute value, so \MP\ does much of its internal -arithmetic with 28~significant bits of precision. A |fraction| denotes -a scaled integer whose binary point is assumed to be 28 bit positions -from the right. - -@d fraction_half 01000000000 /* $2^{27}$, represents 0.50000000 */ -@d fraction_one 02000000000 /* $2^{28}$, represents 1.00000000 */ -@d fraction_two 04000000000 /* $2^{29}$, represents 2.00000000 */ -@d fraction_three 06000000000 /* $3\cdot2^{28}$, represents 3.00000000 */ -@d fraction_four 010000000000 /* $2^{30}$, represents 4.00000000 */ - -@<Types...@>= -typedef integer fraction; /* this type is used for scaled fractions */ - -@ In fact, the two sorts of scaling discussed above aren't quite -sufficient; \MP\ has yet another, used internally to keep track of angles -in units of $2^{-20}$ degrees. - -@d forty_five_deg 0264000000 /* $45\cdot2^{20}$, represents $45^\circ$ */ -@d ninety_deg 0550000000 /* $90\cdot2^{20}$, represents $90^\circ$ */ -@d one_eighty_deg 01320000000 /* $180\cdot2^{20}$, represents $180^\circ$ */ -@d three_sixty_deg 02640000000 /* $360\cdot2^{20}$, represents $360^\circ$ */ - -@<Types...@>= -typedef integer angle; /* this type is used for scaled angles */ - -@ The |make_fraction| routine produces the |fraction| equivalent of -|p/q|, given integers |p| and~|q|; it computes the integer -$f=\lfloor2^{28}p/q+{1\over2}\rfloor$, when $p$ and $q$ are -positive. If |p| and |q| are both of the same scaled type |t|, -the ``type relation'' |make_fraction(t,t)=fraction| is valid; -and it's also possible to use the subroutine ``backwards,'' using -the relation |make_fraction(t,fraction)=t| between scaled types. - -If the result would have magnitude $2^{31}$ or more, |make_fraction| -sets |arith_error:=true|. Most of \MP's internal computations have -been designed to avoid this sort of error. - -If this subroutine were programmed in assembly language on a typical -machine, we could simply compute |(@t$2^{28}$@>*p)div q|, since a -double-precision product can often be input to a fixed-point division -instruction. But when we are restricted to int-eger arithmetic it -is necessary either to resort to multiple-precision maneuvering -or to use a simple but slow iteration. The multiple-precision technique -would be about three times faster than the code adopted here, but it -would be comparatively long and tricky, involving about sixteen -additional multiplications and divisions. - -This operation is part of \MP's ``inner loop''; indeed, it will -consume nearly 10\pct! of the running time (exclusive of input and output) -if the code below is left unchanged. A machine-dependent recoding -will therefore make \MP\ run faster. The present implementation -is highly portable, but slow; it avoids multiplication and division -except in the initial stage. System wizards should be careful to -replace it with a routine that is guaranteed to produce identical -results in all cases. -@^system dependencies@> - -As noted below, a few more routines should also be replaced by machine-dependent -code, for efficiency. But when a procedure is not part of the ``inner loop,'' -such changes aren't advisable; simplicity and robustness are -preferable to trickery, unless the cost is too high. -@^inner loop@> - -@<Internal library declarations@>= -integer mp_take_scaled (MP mp,integer q, scaled f) ; - -@ @<Declarations@>= -static fraction mp_make_fraction (MP mp,integer p, integer q); - -@ If FIXPT is not defined, we need these preprocessor values - -@d TWEXP31 2147483648.0 -@d TWEXP28 268435456.0 -@d TWEXP16 65536.0 -@d TWEXP_16 (1.0/65536.0) -@d TWEXP_28 (1.0/268435456.0) - - -@c -fraction mp_make_fraction (MP mp,integer p, integer q) { - fraction i; - if ( q==0 ) mp_confusion(mp, "/"); -@:this can't happen /}{\quad \./@> -#ifdef FIXPT -{ - integer f; /* the fraction bits, with a leading 1 bit */ - integer n; /* the integer part of $\vert p/q\vert$ */ - boolean negative = false; /* should the result be negated? */ - if ( p<0 ) { - negate(p); negative=true; - } - if ( q<0 ) { - negate(q); negative = ! negative; - } - n=p / q; p=p % q; - if ( n>=8 ){ - mp->arith_error=true; - i= ( negative ? -el_gordo : el_gordo); - } else { - n=(n-1)*fraction_one; - @<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>; - i = (negative ? (-(f+n)) : (f+n)); - } -} -#else /* FIXPT */ - { - register double d; - d = TWEXP28 * (double)p /(double)q; - if ((p^q) >= 0) { - d += 0.5; - if (d>=TWEXP31) {mp->arith_error=true; return el_gordo;} - i = (integer) d; - if (d==(double)i && ( ((q>0 ? -q : q)&077777) - * (((i&037777)<<1)-1) & 04000)!=0) --i; - } else { - d -= 0.5; - if (d<= -TWEXP31) {mp->arith_error=true; return -el_gordo;} - i = (integer) d; - if (d==(double)i && ( ((q>0 ? q : -q)&077777) - * (((i&037777)<<1)+1) & 04000)!=0) ++i; - } - } -#endif /* FIXPT */ - return i; -} - -@ The |repeat| loop here preserves the following invariant relations -between |f|, |p|, and~|q|: -(i)~|0<=p<q|; (ii)~$fq+p=2^k(q+p_0)$, where $k$ is an integer and -$p_0$ is the original value of~$p$. - -Notice that the computation specifies -|(p-q)+p| instead of |(p+p)-q|, because the latter could overflow. -Let us hope that optimizing compilers do not miss this point; a -special variable |be_careful| is used to emphasize the necessary -order of computation. Optimizing compilers should keep |be_careful| -in a register, not store it in memory. -@^inner loop@> - -@<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>= -{ - integer be_careful; /* disables certain compiler optimizations */ - f=1; - do { - be_careful=p-q; p=be_careful+p; - if ( p>=0 ) { - f=f+f+1; - } else { - f+=f; p=p+q; - } - } while (f<fraction_one); - be_careful=p-q; - if ( be_careful+p>=0 ) incr(f); -} - -@ The dual of |make_fraction| is |take_fraction|, which multiplies a -given integer~|q| by a fraction~|f|. When the operands are positive, it -computes $p=\lfloor qf/2^{28}+{1\over2}\rfloor$, a symmetric function -of |q| and~|f|. - -This routine is even more ``inner loopy'' than |make_fraction|; -the present implementation consumes almost 20\pct! of \MP's computation -time during typical jobs, so a machine-language substitute is advisable. -@^inner loop@> @^system dependencies@> - -@<Internal library declarations@>= -integer mp_take_fraction (MP mp,integer q, fraction f) ; - -@ @c -#ifdef FIXPT -integer mp_take_fraction (MP mp,integer q, fraction f) { - integer p; /* the fraction so far */ - boolean negative; /* should the result be negated? */ - integer n; /* additional multiple of $q$ */ - integer be_careful; /* disables certain compiler optimizations */ - @<Reduce to the case that |f>=0| and |q>=0|@>; - if ( f<fraction_one ) { - n=0; - } else { - n=f / fraction_one; f=f % fraction_one; - if ( q<=el_gordo / n ) { - n=n*q ; - } else { - mp->arith_error=true; n=el_gordo; - } - } - f=f+fraction_one; - @<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>; - be_careful=n-el_gordo; - if ( be_careful+p>0 ){ - mp->arith_error=true; n=el_gordo-p; - } - if ( negative ) - return (-(n+p)); - else - return (n+p); -#else /* FIXPT */ -integer mp_take_fraction (MP mp,integer p, fraction q) { - register double d; - register integer i; - d = (double)p * (double)q * TWEXP_28; - if ((p^q) >= 0) { - d += 0.5; - if (d>=TWEXP31) { - if (d!=TWEXP31 || (((p&077777)*(q&077777))&040000)==0) - mp->arith_error = true; - return el_gordo; - } - i = (integer) d; - if (d==(double)i && (((p&077777)*(q&077777))&040000)!=0) --i; - } else { - d -= 0.5; - if (d<= -TWEXP31) { - if (d!= -TWEXP31 || ((-(p&077777)*(q&077777))&040000)==0) - mp->arith_error = true; - return -el_gordo; - } - i = (integer) d; - if (d==(double)i && ((-(p&077777)*(q&077777))&040000)!=0) ++i; - } - return i; -#endif /* FIXPT */ -} - -@ @<Reduce to the case that |f>=0| and |q>=0|@>= -if ( f>=0 ) { - negative=false; -} else { - negate( f); negative=true; -} -if ( q<0 ) { - negate(q); negative=! negative; -} - -@ The invariant relations in this case are (i)~$\lfloor(qf+p)/2^k\rfloor -=\lfloor qf_0/2^{28}+{1\over2}\rfloor$, where $k$ is an integer and -$f_0$ is the original value of~$f$; (ii)~$2^k\L f<2^{k+1}$. -@^inner loop@> - -@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>= -p=fraction_half; /* that's $2^{27}$; the invariants hold now with $k=28$ */ -if ( q<fraction_four ) { - do { - if ( odd(f) ) p=halfp(p+q); else p=halfp(p); - f=halfp(f); - } while (f!=1); -} else { - do { - if ( odd(f) ) p=p+halfp(q-p); else p=halfp(p); - f=halfp(f); - } while (f!=1); -} - - -@ When we want to multiply something by a |scaled| quantity, we use a scheme -analogous to |take_fraction| but with a different scaling. -Given positive operands, |take_scaled| -computes the quantity $p=\lfloor qf/2^{16}+{1\over2}\rfloor$. - -Once again it is a good idea to use a machine-language replacement if -possible; otherwise |take_scaled| will use more than 2\pct! of the running time -when the Computer Modern fonts are being generated. -@^inner loop@> - -@c -#ifdef FIXPT -integer mp_take_scaled (MP mp,integer q, scaled f) { - integer p; /* the fraction so far */ - boolean negative; /* should the result be negated? */ - integer n; /* additional multiple of $q$ */ - integer be_careful; /* disables certain compiler optimizations */ - @<Reduce to the case that |f>=0| and |q>=0|@>; - if ( f<unity ) { - n=0; - } else { - n=f / unity; f=f % unity; - if ( q<=el_gordo / n ) { - n=n*q; - } else { - mp->arith_error=true; n=el_gordo; - } - } - f=f+unity; - @<Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$@>; - be_careful=n-el_gordo; - if ( be_careful+p>0 ) { - mp->arith_error=true; n=el_gordo-p; - } - return ( negative ?(-(n+p)) :(n+p)); -#else /* FIXPT */ -integer mp_take_scaled (MP mp,integer p, scaled q) { - register double d; - register integer i; - d = (double)p * (double)q * TWEXP_16; - if ((p^q) >= 0) { - d += 0.5; - if (d>=TWEXP31) { - if (d!=TWEXP31 || (((p&077777)*(q&077777))&040000)==0) - mp->arith_error = true; - return el_gordo; - } - i = (integer) d; - if (d==(double)i && (((p&077777)*(q&077777))&040000)!=0) --i; - } else { - d -= 0.5; - if (d<= -TWEXP31) { - if (d!= -TWEXP31 || ((-(p&077777)*(q&077777))&040000)==0) - mp->arith_error = true; - return -el_gordo; - } - i = (integer) d; - if (d==(double)i && ((-(p&077777)*(q&077777))&040000)!=0) ++i; - } - return i; -#endif /* FIXPT */ -} - -@ @<Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$@>= -p=half_unit; /* that's $2^{15}$; the invariants hold now with $k=16$ */ -@^inner loop@> -if ( q<fraction_four ) { - do { - p = (odd(f) ? halfp(p+q) : halfp(p)); - f=halfp(f); - } while (f!=1); -} else { - do { - p = (odd(f) ? p+halfp(q-p) : halfp(p)); - f=halfp(f); - } while (f!=1); -} - -@ For completeness, there's also |make_scaled|, which computes a -quotient as a |scaled| number instead of as a |fraction|. -In other words, the result is $\lfloor2^{16}p/q+{1\over2}\rfloor$, if the -operands are positive. \ (This procedure is not used especially often, -so it is not part of \MP's inner loop.) - -@<Internal library ...@>= -scaled mp_make_scaled (MP mp,integer p, integer q) ; - -@ @c -scaled mp_make_scaled (MP mp,integer p, integer q) { - register integer i; - if ( q==0 ) mp_confusion(mp, "/"); -@:this can't happen /}{\quad \./@> - { -#ifdef FIXPT - integer f; /* the fraction bits, with a leading 1 bit */ - integer n; /* the integer part of $\vert p/q\vert$ */ - boolean negative; /* should the result be negated? */ - integer be_careful; /* disables certain compiler optimizations */ - if ( p>=0 ) negative=false; - else { negate(p); negative=true; }; - if ( q<0 ) { - negate(q); negative=! negative; - } - n=p / q; p=p % q; - if ( n>=0100000 ) { - mp->arith_error=true; - return (negative ? (-el_gordo) : el_gordo); - } else { - n=(n-1)*unity; - @<Compute $f=\lfloor 2^{16}(1+p/q)+{1\over2}\rfloor$@>; - i = (negative ? (-(f+n)) :(f+n)); - } -#else /* FIXPT */ - register double d; - d = TWEXP16 * (double)p /(double)q; - if ((p^q) >= 0) { - d += 0.5; - if (d>=TWEXP31) {mp->arith_error=true; return el_gordo;} - i = (integer) d; - if (d==(double)i && ( ((q>0 ? -q : q)&077777) - * (((i&037777)<<1)-1) & 04000)!=0) --i; - } else { - d -= 0.5; - if (d<= -TWEXP31) {mp->arith_error=true; return -el_gordo;} - i = (integer) d; - if (d==(double)i && ( ((q>0 ? q : -q)&077777) - * (((i&037777)<<1)+1) & 04000)!=0) ++i; - } -#endif /* FIXPT */ - } - return i; -} - -@ @<Compute $f=\lfloor 2^{16}(1+p/q)+{1\over2}\rfloor$@>= -f=1; -do { - be_careful=p-q; p=be_careful+p; - if ( p>=0 ) f=f+f+1; - else { f+=f; p=p+q; }; -} while (f<unity); -be_careful=p-q; -if ( be_careful+p>=0 ) incr(f) - -@ Here is a typical example of how the routines above can be used. -It computes the function -$${1\over3\tau}f(\theta,\phi)= -{\tau^{-1}\bigl(2+\sqrt2\,(\sin\theta-{1\over16}\sin\phi) - (\sin\phi-{1\over16}\sin\theta)(\cos\theta-\cos\phi)\bigr)\over -3\,\bigl(1+{1\over2}(\sqrt5-1)\cos\theta+{1\over2}(3-\sqrt5\,)\cos\phi\bigr)},$$ -where $\tau$ is a |scaled| ``tension'' parameter. This is \MP's magic -fudge factor for placing the first control point of a curve that starts -at an angle $\theta$ and ends at an angle $\phi$ from the straight path. -(Actually, if the stated quantity exceeds 4, \MP\ reduces it to~4.) - -The trigonometric quantity to be multiplied by $\sqrt2$ is less than $\sqrt2$. -(It's a sum of eight terms whose absolute values can be bounded using -relations such as $\sin\theta\cos\theta\L{1\over2}$.) Thus the numerator -is positive; and since the tension $\tau$ is constrained to be at least -$3\over4$, the numerator is less than $16\over3$. The denominator is -nonnegative and at most~6. Hence the fixed-point calculations below -are guaranteed to stay within the bounds of a 32-bit computer word. - -The angles $\theta$ and $\phi$ are given implicitly in terms of |fraction| -arguments |st|, |ct|, |sf|, and |cf|, representing $\sin\theta$, $\cos\theta$, -$\sin\phi$, and $\cos\phi$, respectively. - -@c -static fraction mp_velocity (MP mp,fraction st, fraction ct, fraction sf, - fraction cf, scaled t) { - integer acc,num,denom; /* registers for intermediate calculations */ - acc=mp_take_fraction(mp, st-(sf / 16), sf-(st / 16)); - acc=mp_take_fraction(mp, acc,ct-cf); - num=fraction_two+mp_take_fraction(mp, acc,379625062); - /* $2^{28}\sqrt2\approx379625062.497$ */ - denom=fraction_three+mp_take_fraction(mp, ct,497706707)+mp_take_fraction(mp, cf,307599661); - /* $3\cdot2^{27}\cdot(\sqrt5-1)\approx497706706.78$ and - $3\cdot2^{27}\cdot(3-\sqrt5\,)\approx307599661.22$ */ - if ( t!=unity ) num=mp_make_scaled(mp, num,t); - /* |make_scaled(fraction,scaled)=fraction| */ - if ( num / 4>=denom ) - return fraction_four; - else - return mp_make_fraction(mp, num, denom); -} - -@ The following somewhat different subroutine tests rigorously if $ab$ is -greater than, equal to, or less than~$cd$, -given integers $(a,b,c,d)$. In most cases a quick decision is reached. -The result is $+1$, 0, or~$-1$ in the three respective cases. - -@d mp_ab_vs_cd(M,A,B,C,D) mp_do_ab_vs_cd(A,B,C,D) - -@c -static integer mp_do_ab_vs_cd (integer a,integer b, integer c, integer d) { - integer q,r; /* temporary registers */ - @<Reduce to the case that |a,c>=0|, |b,d>0|@>; - while (1) { - q = a / d; r = c / b; - if ( q!=r ) - return ( q>r ? 1 : -1); - q = a % d; r = c % b; - if ( r==0 ) - return (q ? 1 : 0); - if ( q==0 ) return -1; - a=b; b=q; c=d; d=r; - } /* now |a>d>0| and |c>b>0| */ -} - -@ @<Reduce to the case that |a...@>= -if ( a<0 ) { negate(a); negate(b); }; -if ( c<0 ) { negate(c); negate(d); }; -if ( d<=0 ) { - if ( b>=0 ) { - if ( (a==0||b==0)&&(c==0||d==0) ) return 0; - else return 1; - } - if ( d==0 ) - return ( a==0 ? 0 : -1); - q=a; a=c; c=q; q=-b; b=-d; d=q; -} else if ( b<=0 ) { - if ( b<0 ) if ( a>0 ) return -1; - return (c==0 ? 0 : -1); -} - -@ We conclude this set of elementary routines with some simple rounding -and truncation operations. - -@<Internal library declarations@>= -#define mp_floor_scaled(M,i) ((i)&(-65536)) -#define mp_round_unscaled(M,i) (i>0 ? (((i/32768)+1)/2) : (((i/32768)-1)/2)) -#define mp_round_fraction(M,i) (i>0 ? (((i/2048)+1)/2) : (((i/2048)-1)/2)) - - -@* \[8] Algebraic and transcendental functions. -\MP\ computes all of the necessary special functions from scratch, without -relying on |real| arithmetic or system subroutines for sines, cosines, etc. - -@ To get the square root of a |scaled| number |x|, we want to calculate -$s=\lfloor 2^8\!\sqrt x +{1\over2}\rfloor$. If $x>0$, this is the unique -integer such that $2^{16}x-s\L s^2<2^{16}x+s$. The following subroutine -determines $s$ by an iterative method that maintains the invariant -relations $x=2^{46-2k}x_0\bmod 2^{30}$, $0<y=\lfloor 2^{16-2k}x_0\rfloor --s^2+s\L q=2s$, where $x_0$ is the initial value of $x$. The value of~$y$ -might, however, be zero at the start of the first iteration. - -@<Declarations@>= -static scaled mp_square_rt (MP mp,scaled x) ; - -@ @c -scaled mp_square_rt (MP mp,scaled x) { - quarterword k; /* iteration control counter */ - integer y; /* register for intermediate calculations */ - unsigned q; /* register for intermediate calculations */ - if ( x<=0 ) { - @<Handle square root of zero or negative argument@>; - } else { - k=23; q=2; - while ( x<fraction_two ) { /* i.e., |while x<@t$2^{29}$@>|\unskip */ - decr(k); x=x+x+x+x; - } - if ( x<fraction_four ) y=0; - else { x=x-fraction_four; y=1; }; - do { - @<Decrease |k| by 1, maintaining the invariant - relations between |x|, |y|, and~|q|@>; - } while (k!=0); - return (scaled)(halfp(q)); - } -} - -@ @<Handle square root of zero...@>= -{ - if ( x<0 ) { - print_err("Square root of "); -@.Square root...replaced by 0@> - mp_print_scaled(mp, x); mp_print(mp, " has been replaced by 0"); - help2("Since I don't take square roots of negative numbers,", - "I'm zeroing this one. Proceed, with fingers crossed."); - mp_error(mp); - }; - return 0; -} - -@ @<Decrease |k| by 1, maintaining...@>= -x+=x; y+=y; -if ( x>=fraction_four ) { /* note that |fraction_four=@t$2^{30}$@>| */ - x=x-fraction_four; y++; -}; -x+=x; y=y+y-q; q+=q; -if ( x>=fraction_four ) { x=x-fraction_four; y++; }; -if ( y>(int)q ){ y=y-q; q=q+2; } -else if ( y<=0 ) { q=q-2; y=y+q; }; -decr(k) - -@ Pythagorean addition $\psqrt{a^2+b^2}$ is implemented by an elegant -iterative scheme due to Cleve Moler and Donald Morrison [{\sl IBM Journal -@^Moler, Cleve Barry@> -@^Morrison, Donald Ross@> -of Research and Development\/ \bf27} (1983), 577--581]. It modifies |a| and~|b| -in such a way that their Pythagorean sum remains invariant, while the -smaller argument decreases. - -@<Internal library ...@>= -integer mp_pyth_add (MP mp,integer a, integer b); - - -@ @c -integer mp_pyth_add (MP mp,integer a, integer b) { - fraction r; /* register used to transform |a| and |b| */ - boolean big; /* is the result dangerously near $2^{31}$? */ - a=abs(a); b=abs(b); - if ( a<b ) { r=b; b=a; a=r; }; /* now |0<=b<=a| */ - if ( b>0 ) { - if ( a<fraction_two ) { - big=false; - } else { - a=a / 4; b=b / 4; big=true; - }; /* we reduced the precision to avoid arithmetic overflow */ - @<Replace |a| by an approximation to $\psqrt{a^2+b^2}$@>; - if ( big ) { - if ( a<fraction_two ) { - a=a+a+a+a; - } else { - mp->arith_error=true; a=el_gordo; - }; - } - } - return a; -} - -@ The key idea here is to reflect the vector $(a,b)$ about the -line through $(a,b/2)$. - -@<Replace |a| by an approximation to $\psqrt{a^2+b^2}$@>= -while (1) { - r=mp_make_fraction(mp, b,a); - r=mp_take_fraction(mp, r,r); /* now $r\approx b^2/a^2$ */ - if ( r==0 ) break; - r=mp_make_fraction(mp, r,fraction_four+r); - a=a+mp_take_fraction(mp, a+a,r); b=mp_take_fraction(mp, b,r); -} - - -@ Here is a similar algorithm for $\psqrt{a^2-b^2}$. -It converges slowly when $b$ is near $a$, but otherwise it works fine. - -@c -static integer mp_pyth_sub (MP mp,integer a, integer b) { - fraction r; /* register used to transform |a| and |b| */ - boolean big; /* is the input dangerously near $2^{31}$? */ - a=abs(a); b=abs(b); - if ( a<=b ) { - @<Handle erroneous |pyth_sub| and set |a:=0|@>; - } else { - if ( a<fraction_four ) { - big=false; - } else { - a=(integer)halfp(a); b=(integer)halfp(b); big=true; - } - @<Replace |a| by an approximation to $\psqrt{a^2-b^2}$@>; - if ( big ) double(a); - } - return a; -} - -@ @<Replace |a| by an approximation to $\psqrt{a^2-b^2}$@>= -while (1) { - r=mp_make_fraction(mp, b,a); - r=mp_take_fraction(mp, r,r); /* now $r\approx b^2/a^2$ */ - if ( r==0 ) break; - r=mp_make_fraction(mp, r,fraction_four-r); - a=a-mp_take_fraction(mp, a+a,r); b=mp_take_fraction(mp, b,r); -} - -@ @<Handle erroneous |pyth_sub| and set |a:=0|@>= -{ - if ( a<b ){ - print_err("Pythagorean subtraction "); mp_print_scaled(mp, a); - mp_print(mp, "+-+"); mp_print_scaled(mp, b); - mp_print(mp, " has been replaced by 0"); -@.Pythagorean...@> - help2("Since I don't take square roots of negative numbers,", - "I'm zeroing this one. Proceed, with fingers crossed."); - mp_error(mp); - } - a=0; -} - -@ The subroutines for logarithm and exponential involve two tables. -The first is simple: |two_to_the[k]| equals $2^k$. The second involves -a bit more calculation, which the author claims to have done correctly: -|spec_log[k]| is $2^{27}$ times $\ln\bigl(1/(1-2^{-k})\bigr)= -2^{-k}+{1\over2}2^{-2k}+{1\over3}2^{-3k}+\cdots\,$, rounded to the -nearest integer. - -@d two_to_the(A) (1<<(unsigned)(A)) - -@<Declarations@>= -static const integer spec_log[29] = { 0, /* special logarithms */ -93032640, 38612034, 17922280, 8662214, 4261238, 2113709, -1052693, 525315, 262400, 131136, 65552, 32772, 16385, -8192, 4096, 2048, 1024, 512, 256, 128, 64, 32, 16, 8, 4, 2, 1, 1 }; - -@ @<Local variables for initialization@>= -integer k; /* all-purpose loop index */ - - -@ Here is the routine that calculates $2^8$ times the natural logarithm -of a |scaled| quantity; it is an integer approximation to $2^{24}\ln(x/2^{16})$, -when |x| is a given positive integer. - -The method is based on exercise 1.2.2--25 in {\sl The Art of Computer -Programming\/}: During the main iteration we have $1\L 2^{-30}x<1/(1-2^{1-k})$, -and the logarithm of $2^{30}x$ remains to be added to an accumulator -register called~$y$. Three auxiliary bits of accuracy are retained in~$y$ -during the calculation, and sixteen auxiliary bits to extend |y| are -kept in~|z| during the initial argument reduction. (We add -$100\cdot2^{16}=6553600$ to~|z| and subtract 100 from~|y| so that |z| will -not become negative; also, the actual amount subtracted from~|y| is~96, -not~100, because we want to add~4 for rounding before the final division by~8.) - -@c -static scaled mp_m_log (MP mp,scaled x) { - integer y,z; /* auxiliary registers */ - integer k; /* iteration counter */ - if ( x<=0 ) { - @<Handle non-positive logarithm@>; - } else { - y=1302456956+4-100; /* $14\times2^{27}\ln2\approx1302456956.421063$ */ - z=27595+6553600; /* and $2^{16}\times .421063\approx 27595$ */ - while ( x<fraction_four ) { - double(x); y-=93032639; z-=48782; - } /* $2^{27}\ln2\approx 93032639.74436163$ and $2^{16}\times.74436163\approx 48782$ */ - y=y+(z / unity); k=2; - while ( x>fraction_four+4 ) { - @<Increase |k| until |x| can be multiplied by a - factor of $2^{-k}$, and adjust $y$ accordingly@>; - } - return (y / 8); - } -} - -@ @<Increase |k| until |x| can...@>= -{ - z=((x-1) / two_to_the(k))+1; /* $z=\lceil x/2^k\rceil$ */ - while ( x<fraction_four+z ) { z=halfp(z+1); k++; }; - y+=spec_log[k]; x-=z; -} - -@ @<Handle non-positive logarithm@>= -{ - print_err("Logarithm of "); -@.Logarithm...replaced by 0@> - mp_print_scaled(mp, x); mp_print(mp, " has been replaced by 0"); - help2("Since I don't take logs of non-positive numbers,", - "I'm zeroing this one. Proceed, with fingers crossed."); - mp_error(mp); - return 0; -} - -@ Conversely, the exponential routine calculates $\exp(x/2^8)$, -when |x| is |scaled|. The result is an integer approximation to -$2^{16}\exp(x/2^{24})$, when |x| is regarded as an integer. - -@c -static scaled mp_m_exp (MP mp,scaled x) { - quarterword k; /* loop control index */ - integer y,z; /* auxiliary registers */ - if ( x>174436200 ) { - /* $2^{24}\ln((2^{31}-1)/2^{16})\approx 174436199.51$ */ - mp->arith_error=true; - return el_gordo; - } else if ( x<-197694359 ) { - /* $2^{24}\ln(2^{-1}/2^{16})\approx-197694359.45$ */ - return 0; - } else { - if ( x<=0 ) { - z=-8*x; y=04000000; /* $y=2^{20}$ */ - } else { - if ( x<=127919879 ) { - z=1023359037-8*x; - /* $2^{27}\ln((2^{31}-1)/2^{20})\approx 1023359037.125$ */ - } else { - z=8*(174436200-x); /* |z| is always nonnegative */ - } - y=el_gordo; - }; - @<Multiply |y| by $\exp(-z/2^{27})$@>; - if ( x<=127919879 ) - return ((y+8) / 16); - else - return y; - } -} - -@ The idea here is that subtracting |spec_log[k]| from |z| corresponds -to multiplying |y| by $1-2^{-k}$. - -A subtle point (which had to be checked) was that if $x=127919879$, the -value of~|y| will decrease so that |y+8| doesn't overflow. In fact, -$z$ will be 5 in this case, and |y| will decrease by~64 when |k=25| -and by~16 when |k=27|. - -@<Multiply |y| by...@>= -k=1; -while ( z>0 ) { - while ( z>=spec_log[k] ) { - z-=spec_log[k]; - y=y-1-((y-two_to_the(k-1)) / two_to_the(k)); - } - k++; -} - -@ The trigonometric subroutines use an auxiliary table such that -|spec_atan[k]| contains an approximation to the |angle| whose tangent -is~$1/2^k$. $\arctan2^{-k}$ times $2^{20}\cdot180/\pi$ - -@<Declarations@>= -static const angle spec_atan[27] = { 0, 27855475, 14718068, 7471121, 3750058, -1876857, 938658, 469357, 234682, 117342, 58671, 29335, 14668, 7334, 3667, -1833, 917, 458, 229, 115, 57, 29, 14, 7, 4, 2, 1 }; - -@ Given integers |x| and |y|, not both zero, the |n_arg| function -returns the |angle| whose tangent points in the direction $(x,y)$. -This subroutine first determines the correct octant, then solves the -problem for |0<=y<=x|, then converts the result appropriately to -return an answer in the range |-one_eighty_deg<=@t$\theta$@><=one_eighty_deg|. -(The answer is |+one_eighty_deg| if |y=0| and |x<0|, but an answer of -|-one_eighty_deg| is possible if, for example, |y=-1| and $x=-2^{30}$.) - -The octants are represented in a ``Gray code,'' since that turns out -to be computationally simplest. - -@d negate_x 1 -@d negate_y 2 -@d switch_x_and_y 4 -@d first_octant 1 -@d second_octant (first_octant+switch_x_and_y) -@d third_octant (first_octant+switch_x_and_y+negate_x) -@d fourth_octant (first_octant+negate_x) -@d fifth_octant (first_octant+negate_x+negate_y) -@d sixth_octant (first_octant+switch_x_and_y+negate_x+negate_y) -@d seventh_octant (first_octant+switch_x_and_y+negate_y) -@d eighth_octant (first_octant+negate_y) - -@c -static angle mp_n_arg (MP mp,integer x, integer y) { - angle z; /* auxiliary register */ - integer t; /* temporary storage */ - quarterword k; /* loop counter */ - int octant; /* octant code */ - if ( x>=0 ) { - octant=first_octant; - } else { - negate(x); octant=first_octant+negate_x; - } - if ( y<0 ) { - negate(y); octant=octant+negate_y; - } - if ( x<y ) { - t=y; y=x; x=t; octant=octant+switch_x_and_y; - } - if ( x==0 ) { - @<Handle undefined arg@>; - } else { - @<Set variable |z| to the arg of $(x,y)$@>; - @<Return an appropriate answer based on |z| and |octant|@>; - } -} - -@ @<Handle undefined arg@>= -{ - print_err("angle(0,0) is taken as zero"); -@.angle(0,0)...zero@> - help2("The `angle' between two identical points is undefined.", - "I'm zeroing this one. Proceed, with fingers crossed."); - mp_error(mp); - return 0; -} - -@ @<Return an appropriate answer...@>= -switch (octant) { -case first_octant: return z; -case second_octant: return (ninety_deg-z); -case third_octant: return (ninety_deg+z); -case fourth_octant: return (one_eighty_deg-z); -case fifth_octant: return (z-one_eighty_deg); -case sixth_octant: return (-z-ninety_deg); -case seventh_octant: return (z-ninety_deg); -case eighth_octant: return (-z); -}; /* there are no other cases */ -return 0 - -@ At this point we have |x>=y>=0|, and |x>0|. The numbers are scaled up -or down until $2^{28}\L x<2^{29}$, so that accurate fixed-point calculations -will be made. - -@<Set variable |z| to the arg...@>= -while ( x>=fraction_two ) { - x=halfp(x); y=halfp(y); -} -z=0; -if ( y>0 ) { - while ( x<fraction_one ) { - x+=x; y+=y; - }; - @<Increase |z| to the arg of $(x,y)$@>; -} - -@ During the calculations of this section, variables |x| and~|y| -represent actual coordinates $(x,2^{-k}y)$. We will maintain the -condition |x>=y|, so that the tangent will be at most $2^{-k}$. -If $x<2y$, the tangent is greater than $2^{-k-1}$. The transformation -$(a,b)\mapsto(a+b\tan\phi,b-a\tan\phi)$ replaces $(a,b)$ by -coordinates whose angle has decreased by~$\phi$; in the special case -$a=x$, $b=2^{-k}y$, and $\tan\phi=2^{-k-1}$, this operation reduces -to the particularly simple iteration shown here. [Cf.~John E. Meggitt, -@^Meggitt, John E.@> -{\sl IBM Journal of Research and Development\/ \bf6} (1962), 210--226.] - -The initial value of |x| will be multiplied by at most -$(1+{1\over2})(1+{1\over8})(1+{1\over32})\cdots\approx 1.7584$; hence -there is no chance of integer overflow. - -@<Increase |z|...@>= -k=0; -do { - y+=y; k++; - if ( y>x ){ - z=z+spec_atan[k]; t=x; x=x+(y / two_to_the(k+k)); y=y-t; - }; -} while (k!=15); -do { - y+=y; k++; - if ( y>x ) { z=z+spec_atan[k]; y=y-x; }; -} while (k!=26) - -@ Conversely, the |n_sin_cos| routine takes an |angle| and produces the sine -and cosine of that angle. The results of this routine are -stored in global integer variables |n_sin| and |n_cos|. - -@<Glob...@>= -fraction n_sin;fraction n_cos; /* results computed by |n_sin_cos| */ - -@ Given an integer |z| that is $2^{20}$ times an angle $\theta$ in degrees, -the purpose of |n_sin_cos(z)| is to set -|x=@t$r\cos\theta$@>| and |y=@t$r\sin\theta$@>| (approximately), -for some rather large number~|r|. The maximum of |x| and |y| -will be between $2^{28}$ and $2^{30}$, so that there will be hardly -any loss of accuracy. Then |x| and~|y| are divided by~|r|. - -@c -static void mp_n_sin_cos (MP mp,angle z) { /* computes a multiple of the sine - and cosine */ - quarterword k; /* loop control variable */ - int q; /* specifies the quadrant */ - fraction r; /* magnitude of |(x,y)| */ - integer x,y,t; /* temporary registers */ - while ( z<0 ) z=z+three_sixty_deg; - z=z % three_sixty_deg; /* now |0<=z<three_sixty_deg| */ - q=z / forty_five_deg; z=z % forty_five_deg; - x=fraction_one; y=x; - if ( ! odd(q) ) z=forty_five_deg-z; - @<Subtract angle |z| from |(x,y)|@>; - @<Convert |(x,y)| to the octant determined by~|q|@>; - r=mp_pyth_add(mp, x,y); - mp->n_cos=mp_make_fraction(mp, x,r); - mp->n_sin=mp_make_fraction(mp, y,r); -} - -@ In this case the octants are numbered sequentially. - -@<Convert |(x,...@>= -switch (q) { -case 0: break; -case 1: t=x; x=y; y=t; break; -case 2: t=x; x=-y; y=t; break; -case 3: negate(x); break; -case 4: negate(x); negate(y); break; -case 5: t=x; x=-y; y=-t; break; -case 6: t=x; x=y; y=-t; break; -case 7: negate(y); break; -} /* there are no other cases */ - -@ The main iteration of |n_sin_cos| is similar to that of |n_arg| but -applied in reverse. The values of |spec_atan[k]| decrease slowly enough -that this loop is guaranteed to terminate before the (nonexistent) value -|spec_atan[27]| would be required. - -@<Subtract angle |z|...@>= -k=1; -while ( z>0 ){ - if ( z>=spec_atan[k] ) { - z=z-spec_atan[k]; t=x; - x=t+y / two_to_the(k); - y=y-t / two_to_the(k); - } - k++; -} -if ( y<0 ) y=0 /* this precaution may never be needed */ - -@ And now let's complete our collection of numeric utility routines -by considering random number generation. -\MP\ generates pseudo-random numbers with the additive scheme recommended -in Section 3.6 of {\sl The Art of Computer Programming}; however, the -results are random fractions between 0 and |fraction_one-1|, inclusive. - -There's an auxiliary array |randoms| that contains 55 pseudo-random -fractions. Using the recurrence $x_n=(x_{n-55}-x_{n-31})\bmod 2^{28}$, -we generate batches of 55 new $x_n$'s at a time by calling |new_randoms|. -The global variable |j_random| tells which element has most recently -been consumed. -The global variable |random_seed| was introduced in version 0.9, -for the sole reason of stressing the fact that the initial value of the -random seed is system-dependant. The initialization code below will initialize -this variable to |(internal[mp_time] div unity)+internal[mp_day]|, but this -is not good enough on modern fast machines that are capable of running -multiple MetaPost processes within the same second. -@^system dependencies@> - -@<Glob...@>= -fraction randoms[55]; /* the last 55 random values generated */ -int j_random; /* the number of unused |randoms| */ - -@ @<Option variables@>= -int random_seed; /* the default random seed */ - -@ @<Allocate or initialize ...@>= -mp->random_seed = (scaled)opt->random_seed; - -@ To consume a random fraction, the program below will say `|next_random|' -and then it will fetch |randoms[j_random]|. - -@d next_random { if ( mp->j_random==0 ) mp_new_randoms(mp); - else decr(mp->j_random); } - -@c -static void mp_new_randoms (MP mp) { - int k; /* index into |randoms| */ - fraction x; /* accumulator */ - for (k=0;k<=23;k++) { - x=mp->randoms[k]-mp->randoms[k+31]; - if ( x<0 ) x=x+fraction_one; - mp->randoms[k]=x; - } - for (k=24;k<= 54;k++){ - x=mp->randoms[k]-mp->randoms[k-24]; - if ( x<0 ) x=x+fraction_one; - mp->randoms[k]=x; - } - mp->j_random=54; -} - -@ @<Declarations@>= -static void mp_init_randoms (MP mp,scaled seed); - -@ To initialize the |randoms| table, we call the following routine. - -@c -void mp_init_randoms (MP mp,scaled seed) { - fraction j,jj,k; /* more or less random integers */ - int i; /* index into |randoms| */ - j=abs(seed); - while ( j>=fraction_one ) j=halfp(j); - k=1; - for (i=0;i<=54;i++ ){ - jj=k; k=j-k; j=jj; - if ( k<0 ) k=k+fraction_one; - mp->randoms[(i*21)% 55]=j; - } - mp_new_randoms(mp); - mp_new_randoms(mp); - mp_new_randoms(mp); /* ``warm up'' the array */ -} - -@ To produce a uniform random number in the range |0<=u<x| or |0>=u>x| -or |0=u=x|, given a |scaled| value~|x|, we proceed as shown here. - -Note that the call of |take_fraction| will produce the values 0 and~|x| -with about half the probability that it will produce any other particular -values between 0 and~|x|, because it rounds its answers. - -@c -static scaled mp_unif_rand (MP mp,scaled x) { - scaled y; /* trial value */ - next_random; y=mp_take_fraction(mp, abs(x),mp->randoms[mp->j_random]); - if ( y==abs(x) ) return 0; - else if ( x>0 ) return y; - else return (-y); -} - -@ Finally, a normal deviate with mean zero and unit standard deviation -can readily be obtained with the ratio method (Algorithm 3.4.1R in -{\sl The Art of Computer Programming\/}). - -@c -static scaled mp_norm_rand (MP mp) { - integer x,u,l; /* what the book would call $2^{16}X$, $2^{28}U$, and $-2^{24}\ln U$ */ - do { - do { - next_random; - x=mp_take_fraction(mp, 112429,mp->randoms[mp->j_random]-fraction_half); - /* $2^{16}\sqrt{8/e}\approx 112428.82793$ */ - next_random; u=mp->randoms[mp->j_random]; - } while (abs(x)>=u); - x=mp_make_fraction(mp, x,u); - l=139548960-mp_m_log(mp, u); /* $2^{24}\cdot12\ln2\approx139548959.6165$ */ - } while (mp_ab_vs_cd(mp, 1024,l,x,x)<0); - return x; -} - -@* \[9] Packed data. -In order to make efficient use of storage space, \MP\ bases its major data -structures on a |memory_word|, which contains either a (signed) integer, -possibly scaled, or a small number of fields that are one half or one -quarter of the size used for storing integers. - -If |x| is a variable of type |memory_word|, it contains up to four -fields that can be referred to as follows: -$$\vbox{\halign{\hfil#&#\hfil&#\hfil\cr -|x|&.|int|&(an |integer|)\cr -|x|&.|sc|\qquad&(a |scaled| integer)\cr -|x.hh.lh|, |x.hh|&.|rh|&(two halfword fields)\cr -|x.hh.b0|, |x.hh.b1|, |x.hh|&.|rh|&(two quarterword fields, one halfword - field)\cr -|x.qqqq.b0|, |x.qqqq.b1|, |x.qqqq|&.|b2|, |x.qqqq.b3|\hskip-100pt - &\qquad\qquad\qquad(four quarterword fields)\cr}}$$ -This is somewhat cumbersome to write, and not very readable either, but -macros will be used to make the notation shorter and more transparent. -The code below gives a formal definition of |memory_word| and -its subsidiary types, using packed variant records. \MP\ makes no -assumptions about the relative positions of the fields within a word. - -@d max_quarterword 0x3FFF /* largest allowable value in a |quarterword| */ -@d max_halfword 0xFFFFFFF /* largest allowable value in a |halfword| */ - -@ Here are the inequalities that the quarterword and halfword values -must satisfy (or rather, the inequalities that they mustn't satisfy): - -@<Check the ``constant''...@>= -if (mp->ini_version) { - if ( mp->mem_max!=mp->mem_top ) mp->bad=8; -} else { - if ( mp->mem_max<mp->mem_top ) mp->bad=8; -} -if ( mp->mem_max>=max_halfword ) mp->bad=12; -if ( mp->max_strings>max_halfword ) mp->bad=13; - -@ The macros |qi| and |qo| are used for input to and output -from quarterwords. These are legacy macros. -@^system dependencies@> - -@d qo(A) (A) /* to read eight bits from a quarterword */ -@d qi(A) (quarterword)(A) /* to store eight bits in a quarterword */ - -@ The reader should study the following definitions closely: -@^system dependencies@> - -@d sc cint /* |scaled| data is equivalent to |integer| */ - -@<Types...@>= -typedef short quarterword; /* 1/4 of a word */ -typedef int halfword; /* 1/2 of a word */ -typedef union { - struct { - halfword RH, LH; - } v; - struct { /* Make B0,B1 overlap the most significant bytes of LH. */ - halfword junk; - quarterword B0, B1; - } u; -} two_halves; -typedef struct { - struct { - quarterword B2, B3, B0, B1; - } u; -} four_quarters; -typedef union { - two_halves hh; - integer cint; - four_quarters qqqq; -} memory_word; -#define b0 u.B0 -#define b1 u.B1 -#define b2 u.B2 -#define b3 u.B3 -#define rh v.RH -#define lh v.LH - -@ When debugging, we may want to print a |memory_word| without knowing -what type it is; so we print it in all modes. -@^debugging@> - -@c -void mp_print_word (MP mp,memory_word w) { - /* prints |w| in all ways */ - mp_print_int(mp, w.cint); mp_print_char(mp, xord(' ')); - mp_print_scaled(mp, w.sc); mp_print_char(mp, xord(' ')); - mp_print_scaled(mp, w.sc / 010000); mp_print_ln(mp); - mp_print_int(mp, w.hh.lh); mp_print_char(mp, xord('=')); - mp_print_int(mp, w.hh.b0); mp_print_char(mp, xord(':')); - mp_print_int(mp, w.hh.b1); mp_print_char(mp, xord(';')); - mp_print_int(mp, w.hh.rh); mp_print_char(mp, xord(' ')); - mp_print_int(mp, w.qqqq.b0); mp_print_char(mp, xord(':')); - mp_print_int(mp, w.qqqq.b1); mp_print_char(mp, xord(':')); - mp_print_int(mp, w.qqqq.b2); mp_print_char(mp, xord(':')); - mp_print_int(mp, w.qqqq.b3); -} - - -@* \[10] Dynamic memory allocation. - -The \MP\ system does nearly all of its own memory allocation, so that it -can readily be transported into environments that do not have automatic -facilities for strings, garbage collection, etc., and so that it can be in -control of what error messages the user receives. The dynamic storage -requirements of \MP\ are handled by providing a large array |mem| in -which consecutive blocks of words are used as nodes by the \MP\ routines. - -Pointer variables are indices into this array, or into another array -called |eqtb| that will be explained later. A pointer variable might -also be a special flag that lies outside the bounds of |mem|, so we -allow pointers to assume any |halfword| value. The minimum memory -index represents a null pointer. - -@d null 0 /* the null pointer */ -@d mp_void (null+1) /* a null pointer different from |null| */ - - -@<Types...@>= -typedef halfword pointer; /* a flag or a location in |mem| or |eqtb| */ - -@ The |mem| array is divided into two regions that are allocated separately, -but the dividing line between these two regions is not fixed; they grow -together until finding their ``natural'' size in a particular job. -Locations less than or equal to |lo_mem_max| are used for storing -variable-length records consisting of two or more words each. This region -is maintained using an algorithm similar to the one described in exercise -2.5--19 of {\sl The Art of Computer Programming}. However, no size field -appears in the allocated nodes; the program is responsible for knowing the -relevant size when a node is freed. Locations greater than or equal to -|hi_mem_min| are used for storing one-word records; a conventional -\.{AVAIL} stack is used for allocation in this region. - -Locations of |mem| between |0| and |mem_top| may be dumped as part -of preloaded mem files, by the \.{INIMP} preprocessor. -@.INIMP@> -Production versions of \MP\ may extend the memory at the top end in order to -provide more space; these locations, between |mem_top| and |mem_max|, -are always used for single-word nodes. - -The key pointers that govern |mem| allocation have a prescribed order: -$$\hbox{|null=0<lo_mem_max<hi_mem_min<mem_top<=mem_end<=mem_max|.}$$ - -@<Glob...@>= -memory_word *mem; /* the big dynamic storage area */ -pointer lo_mem_max; /* the largest location of variable-size memory in use */ -pointer hi_mem_min; /* the smallest location of one-word memory in use */ - - -@ -@d xfree(A) do { mp_xfree(A); A=NULL; } while (0) -@d xrealloc(P,A,B) mp_xrealloc(mp,P,(size_t)A,B) -@d xmalloc(A,B) mp_xmalloc(mp,(size_t)A,B) -@d xstrdup(A) mp_xstrdup(mp,A) -@d XREALLOC(a,b,c) a = xrealloc(a,(b+1),sizeof(c)); - -@<Declare helpers@>= -extern char *mp_strdup(const char *p) ; -extern char *mp_strldup(const char *p, size_t l) ; -extern void mp_xfree ( @= /*@@only@@*/ /*@@out@@*/ /*@@null@@*/ @> void *x); -extern @= /*@@only@@*/ @> void *mp_xrealloc (MP mp, void *p, size_t nmem, size_t size) ; -extern @= /*@@only@@*/ @> void *mp_xmalloc (MP mp, size_t nmem, size_t size) ; -extern @= /*@@only@@*/ @> char *mp_xstrdup(MP mp, const char *s); -extern @= /*@@only@@*/ @> char *mp_xstrldup(MP mp, const char *s, size_t l); -extern void mp_do_snprintf(char *str, int size, const char *fmt, ...); - -@ The |max_size_test| guards against overflow, on the assumption that -|size_t| is at least 31bits wide. - -@d max_size_test 0x7FFFFFFF - -@c -char *mp_strldup(const char *p, size_t l) { - char *r; - if (p==NULL) return NULL; - r = malloc ((size_t)(l*sizeof(char)+1)); - if (r==NULL) - return NULL; - return memcpy (r,p,(size_t)(l+1)); -} -char *mp_strdup(const char *p) { - if (p==NULL) return NULL; - return mp_strldup(p, strlen(p)); -} -void mp_xfree (void *x) { - if (x!=NULL) free(x); -} -void *mp_xrealloc (MP mp, void *p, size_t nmem, size_t size) { - void *w ; - if ((max_size_test/size)<nmem) { - do_fprintf(mp->err_out,"Memory size overflow!\n"); - mp->history =mp_fatal_error_stop; mp_jump_out(mp); - } - w = realloc (p,(nmem*size)); - if (w==NULL) { - do_fprintf(mp->err_out,"Out of memory!\n"); - mp->history =mp_system_error_stop; mp_jump_out(mp); - } - return w; -} -void *mp_xmalloc (MP mp, size_t nmem, size_t size) { - void *w; - if ((max_size_test/size)<nmem) { - do_fprintf(mp->err_out,"Memory size overflow!\n"); - mp->history =mp_fatal_error_stop; mp_jump_out(mp); - } - w = malloc (nmem*size); - if (w==NULL) { - do_fprintf(mp->err_out,"Out of memory!\n"); - mp->history =mp_system_error_stop; mp_jump_out(mp); - } - return w; -} -char *mp_xstrldup(MP mp, const char *s, size_t l) { - char *w; - if (s==NULL) - return NULL; - w = mp_strldup(s, l); - if (w==NULL) { - do_fprintf(mp->err_out,"Out of memory!\n"); - mp->history =mp_system_error_stop; mp_jump_out(mp); - } - return w; -} -char *mp_xstrdup(MP mp, const char *s) { - if (s==NULL) return NULL; - return mp_xstrldup(mp,s,strlen(s)); -} - - -@ @<Internal library declarations@>= -#ifdef HAVE_SNPRINTF -extern int snprintf(char *str, size_t size, const char *format, ...); -#define mp_snprintf (void)snprintf -#else -#define mp_snprintf mp_do_snprintf -#endif - -@ This internal version is rather stupid, but good enough for its purpose. - -@c -static char *mp_itoa (int i) { - char res[32] ; - unsigned idx = 30; - unsigned v = (unsigned)abs(i); - memset(res,0,32*sizeof(char)); - while (v>=10) { - char d = (char)(v % 10); - v = v / 10; - res[idx--] = (char)d + '0'; - } - res[idx--] = (char)v + '0'; - if (i<0) { - res[idx--] = '-'; - } - return mp_strdup((res+idx+1)); -} -static char *mp_utoa (unsigned v) { - char res[32] ; - unsigned idx = 30; - memset(res,0,32*sizeof(char)); - while (v>=10) { - char d = (char)(v % 10); - v = v / 10; - res[idx--] = d + '0'; - } - res[idx--] = (char)v + '0'; - return mp_strdup((res+idx+1)); -} -void mp_do_snprintf (char *str, int size, const char *format, ...) { - const char *fmt; - char *res; - int fw, pad; - va_list ap; - va_start(ap, format); - res = str; - for (fmt=format;*fmt!='\0';fmt++) { - if (*fmt=='%') { - fw=0; - pad=0; - fmt++; - switch(*fmt) { - case '0': - pad=1; - break; - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - assert(fw==0); - fw = *fmt-'0'; - break; - case 's': - { - char *s = va_arg(ap, char *); - while (*s) { - *res = *s++; - if (size-->0) res++; - } - } - break; - case 'i': - case 'd': - { - char *s = mp_itoa(va_arg(ap, int)); - if (fw) { - int ffw = fw-strlen(s); - while (ffw-->0) { - *res = (pad ? '0' : ' '); - if (size-->0) res++; - } - } - if (s != NULL) { - while (*s) { - *res = *s++; - if (size-->0) res++; - } - } - } - break; - case 'u': - { - char *s = mp_utoa(va_arg(ap, unsigned)); - if (fw) { - int ffw = fw-strlen(s); - while (ffw-->0) { - *res = (pad ? '0' : ' '); - if (size-->0) res++; - } - } - if (s != NULL) { - while (*s) { - *res = *s++; - if (size-->0) res++; - } - } - } - break; - case '%': - *res = '%'; - if (size-->0) res++; - break; - default: - *res = '%'; - if (size-->0) res++; - *res = *fmt; - if (size-->0) res++; - break; - } - } else { - *res = *fmt; - if (size-->0) res++; - } - } - *res = '\0'; - va_end(ap); -} - -@ -@<Allocate or initialize ...@>= -mp->mem = xmalloc ((mp->mem_max+1),sizeof (memory_word)); -memset(mp->mem,0,(mp->mem_max+1)*sizeof (memory_word)); - -@ @<Dealloc variables@>= -xfree(mp->mem); - -@ Users who wish to study the memory requirements of particular applications can -can use optional special features that keep track of current and -maximum memory usage. When code between the delimiters |stat| $\ldots$ -|tats| is not ``commented out,'' \MP\ will run a bit slower but it will -report these statistics when |mp_tracing_stats| is positive. - -@<Glob...@>= -integer var_used; integer dyn_used; /* how much memory is in use */ - -@ Let's consider the one-word memory region first, since it's the -simplest. The pointer variable |mem_end| holds the highest-numbered location -of |mem| that has ever been used. The free locations of |mem| that -occur between |hi_mem_min| and |mem_end|, inclusive, are of type -|two_halves|, and we write |info(p)| and |mp_link(p)| for the |lh| -and |rh| fields of |mem[p]| when it is of this type. The single-word -free locations form a linked list -$$|avail|,\;\hbox{|mp_link(avail)|},\;\hbox{|mp_link(mp_link(avail))|},\;\ldots$$ -terminated by |null|. - -@(mpmp.h@>= -#define mp_link(A) mp->mem[(A)].hh.rh /* the |link| field of a memory word */ -#define mp_info(A) mp->mem[(A)].hh.lh /* the |info| field of a memory word */ - -@ @<Glob...@>= -pointer avail; /* head of the list of available one-word nodes */ -pointer mem_end; /* the last one-word node used in |mem| */ - -@ If one-word memory is exhausted, it might mean that the user has forgotten -a token like `\&{enddef}' or `\&{endfor}'. We will define some procedures -later that try to help pinpoint the trouble. - -@ The function |get_avail| returns a pointer to a new one-word node whose -|link| field is null. However, \MP\ will halt if there is no more room left. -@^inner loop@> - -@c -static pointer mp_get_avail (MP mp) { /* single-word node allocation */ - pointer p; /* the new node being got */ - p=mp->avail; /* get top location in the |avail| stack */ - if ( p!=null ) { - mp->avail=mp_link(mp->avail); /* and pop it off */ - } else if ( mp->mem_end<mp->mem_max ) { /* or go into virgin territory */ - incr(mp->mem_end); p=mp->mem_end; - } else { - decr(mp->hi_mem_min); p=mp->hi_mem_min; - if ( mp->hi_mem_min<=mp->lo_mem_max ) { - mp_runaway(mp); /* if memory is exhausted, display possible runaway text */ - mp_overflow(mp, "main memory size",mp->mem_max); - /* quit; all one-word nodes are busy */ -@:MetaPost capacity exceeded main memory size}{\quad main memory size@> - } - } - mp_link(p)=null; /* provide an oft-desired initialization of the new node */ - incr(mp->dyn_used);/* maintain statistics */ - return p; -} - -@ Conversely, a one-word node is recycled by calling |free_avail|. - -@d free_avail(A) /* single-word node liberation */ - { mp_link((A))=mp->avail; mp->avail=(A); decr(mp->dyn_used); } - -@ There's also a |fast_get_avail| routine, which saves the procedure-call -overhead at the expense of extra programming. This macro is used in -the places that would otherwise account for the most calls of |get_avail|. -@^inner loop@> - -@d fast_get_avail(A) { - (A)=mp->avail; /* avoid |get_avail| if possible, to save time */ - if ( (A)==null ) { (A)=mp_get_avail(mp); } - else { mp->avail=mp_link((A)); mp_link((A))=null; incr(mp->dyn_used); } - } - -@ The available-space list that keeps track of the variable-size portion -of |mem| is a nonempty, doubly-linked circular list of empty nodes, -pointed to by the roving pointer |rover|. - -Each empty node has size 2 or more; the first word contains the special -value |max_halfword| in its |link| field and the size in its |info| field; -the second word contains the two pointers for double linking. - -Each nonempty node also has size 2 or more. Its first word is of type -|two_halves|\kern-1pt, and its |link| field is never equal to |max_halfword|. -Otherwise there is complete flexibility with respect to the contents -of its other fields and its other words. - -(We require |mem_max<max_halfword| because terrible things can happen -when |max_halfword| appears in the |link| field of a nonempty node.) - -@d empty_flag max_halfword /* the |link| of an empty variable-size node */ -@d is_empty(A) (mp_link((A))==empty_flag) /* tests for empty node */ - -@(mpmp.h@>= -#define node_size mp_info /* the size field in empty variable-size nodes */ -#define lmp_link(A) mp_info((A)+1) /* left link in doubly-linked list of empty nodes */ -#define rmp_link(A) mp_link((A)+1) /* right link in doubly-linked list of empty nodes */ - -@ @<Glob...@>= -pointer rover; /* points to some node in the list of empties */ - -@ A call to |get_node| with argument |s| returns a pointer to a new node -of size~|s|, which must be 2~or more. The |link| field of the first word -of this new node is set to null. An overflow stop occurs if no suitable -space exists. - -If |get_node| is called with $s=2^{30}$, it simply merges adjacent free -areas and returns the value |max_halfword|. - -@<Internal library declarations@>= -pointer mp_get_node (MP mp,integer s) ; - -@ @c -pointer mp_get_node (MP mp,integer s) { /* variable-size node allocation */ - pointer p; /* the node currently under inspection */ - pointer q; /* the node physically after node |p| */ - integer r; /* the newly allocated node, or a candidate for this honor */ - integer t,tt; /* temporary registers */ -@^inner loop@> - RESTART: - p=mp->rover; /* start at some free node in the ring */ - do { - @<Try to allocate within node |p| and its physical successors, - and |goto found| if allocation was possible@>; - if (rmp_link(p)==null || (rmp_link(p)==p && p!=mp->rover)) { - print_err("Free list garbled"); - help3("I found an entry in the list of free nodes that links", - "badly. I will try to ignore the broken link, but something", - "is seriously amiss. It is wise to warn the maintainers.") - mp_error(mp); - rmp_link(p)=mp->rover; - } - p=rmp_link(p); /* move to the next node in the ring */ - } while (p!=mp->rover); /* repeat until the whole list has been traversed */ - if ( s==010000000000 ) { - return max_halfword; - }; - if ( mp->lo_mem_max+2<mp->hi_mem_min ) { - if ( mp->lo_mem_max+2<=max_halfword ) { - @<Grow more variable-size memory and |goto restart|@>; - } - } - mp_overflow(mp, "main memory size",mp->mem_max); - /* sorry, nothing satisfactory is left */ -@:MetaPost capacity exceeded main memory size}{\quad main memory size@> -FOUND: - mp_link(r)=null; /* this node is now nonempty */ - mp->var_used+=s; /* maintain usage statistics */ - return r; -} - -@ The lower part of |mem| grows by 1000 words at a time, unless -we are very close to going under. When it grows, we simply link -a new node into the available-space list. This method of controlled -growth helps to keep the |mem| usage consecutive when \MP\ is -implemented on ``virtual memory'' systems. -@^virtual memory@> - -@<Grow more variable-size memory and |goto restart|@>= -{ - if ( mp->hi_mem_min-mp->lo_mem_max>=1998 ) { - t=mp->lo_mem_max+1000; - } else { - t=mp->lo_mem_max+1+(mp->hi_mem_min-mp->lo_mem_max) / 2; - /* |lo_mem_max+2<=t<hi_mem_min| */ - } - if ( t>max_halfword ) t=max_halfword; - p=lmp_link(mp->rover); q=mp->lo_mem_max; rmp_link(p)=q; lmp_link(mp->rover)=q; - rmp_link(q)=mp->rover; lmp_link(q)=p; mp_link(q)=empty_flag; - node_size(q)=t-mp->lo_mem_max; - mp->lo_mem_max=t; mp_link(mp->lo_mem_max)=null; mp_info(mp->lo_mem_max)=null; - mp->rover=q; - goto RESTART; -} - -@ @<Try to allocate...@>= -q=p+node_size(p); /* find the physical successor */ -while ( is_empty(q) ) { /* merge node |p| with node |q| */ - t=rmp_link(q); tt=lmp_link(q); -@^inner loop@> - if ( q==mp->rover ) mp->rover=t; - lmp_link(t)=tt; rmp_link(tt)=t; - q=q+node_size(q); -} -r=q-s; -if ( r>p+1 ) { - @<Allocate from the top of node |p| and |goto found|@>; -} -if ( r==p ) { - if ( rmp_link(p)!=p ) { - @<Allocate entire node |p| and |goto found|@>; - } -} -node_size(p)=q-p /* reset the size in case it grew */ - -@ @<Allocate from the top...@>= -{ - node_size(p)=r-p; /* store the remaining size */ - mp->rover=p; /* start searching here next time */ - goto FOUND; -} - -@ Here we delete node |p| from the ring, and let |rover| rove around. - -@<Allocate entire...@>= -{ - mp->rover=rmp_link(p); t=lmp_link(p); - lmp_link(mp->rover)=t; rmp_link(t)=mp->rover; - goto FOUND; -} - -@ Conversely, when some variable-size node |p| of size |s| is no longer needed, -the operation |free_node(p,s)| will make its words available, by inserting -|p| as a new empty node just before where |rover| now points. - -@<Internal library declarations@>= -void mp_free_node (MP mp, pointer p, halfword s) ; - -@ @c -void mp_free_node (MP mp, pointer p, halfword s) { /* variable-size node - liberation */ - pointer q; /* |lmp_link(rover)| */ - node_size(p)=s; mp_link(p)=empty_flag; -@^inner loop@> - q=lmp_link(mp->rover); lmp_link(p)=q; rmp_link(p)=mp->rover; /* set both links */ - lmp_link(mp->rover)=p; rmp_link(q)=p; /* insert |p| into the ring */ - mp->var_used-=s; /* maintain statistics */ -} - -@* \[11] Memory layout. -Some areas of |mem| are dedicated to fixed usage, since static allocation is -more efficient than dynamic allocation when we can get away with it. For -example, locations |0| to |1| are always used to store a -two-word dummy token whose second word is zero. -The following macro definitions accomplish the static allocation by giving -symbolic names to the fixed positions. Static variable-size nodes appear -in locations |0| through |lo_mem_stat_max|, and static single-word nodes -appear in locations |hi_mem_stat_min| through |mem_top|, inclusive. - -@d sentinel mp->mem_top /* end of sorted lists */ -@d temp_head (mp->mem_top-1) /* head of a temporary list of some kind */ -@d hold_head (mp->mem_top-2) /* head of a temporary list of another kind */ - -@(mpmp.h@>= -#define spec_head (mp->mem_top-3) /* head of a list of unprocessed \&{special} items */ -#define null_dash (2) /* the first two words are reserved for a null value */ -#define dep_head (null_dash+3) /* we will define |dash_node_size=3| */ -#define zero_val (dep_head+2) /* two words for a permanently zero value */ -#define temp_val (zero_val+2) /* two words for a temporary value node */ -#define end_attr temp_val /* we use |end_attr+2| only */ -#define inf_val (end_attr+2) /* and |inf_val+1| only */ -#define bad_vardef (inf_val+2) /* two words for \&{vardef} error recovery */ -#define lo_mem_stat_max (bad_vardef+1) /* largest statically - allocated word in the variable-size |mem| */ -#define hi_mem_stat_min (mp->mem_top-3) /* smallest statically allocated word in - the one-word |mem| */ - -@ The following code gets the dynamic part of |mem| off to a good start, -when \MP\ is initializing itself the slow way. - -@<Initialize table entries (done by \.{INIMP} only)@>= -mp->rover=lo_mem_stat_max+1; /* initialize the dynamic memory */ -mp_link(mp->rover)=empty_flag; -node_size(mp->rover)=1000; /* which is a 1000-word available node */ -lmp_link(mp->rover)=mp->rover; rmp_link(mp->rover)=mp->rover; -mp->lo_mem_max=mp->rover+1000; -mp_link(mp->lo_mem_max)=null; mp_info(mp->lo_mem_max)=null; -for (k=hi_mem_stat_min;k<=(int)mp->mem_top;k++) { - mp->mem[k]=mp->mem[mp->lo_mem_max]; /* clear list heads */ -} -mp->avail=null; mp->mem_end=mp->mem_top; -mp->hi_mem_min=hi_mem_stat_min; /* initialize the one-word memory */ -mp->var_used=lo_mem_stat_max+1; -mp->dyn_used=mp->mem_top+1-(hi_mem_stat_min); /* initialize statistics */ - -@ The procedure |flush_list(p)| frees an entire linked list of one-word -nodes that starts at a given position, until coming to |sentinel| or a -pointer that is not in the one-word region. Another procedure, -|flush_node_list|, frees an entire linked list of one-word and two-word -nodes, until coming to a |null| pointer. -@^inner loop@> - -@c -static void mp_flush_list (MP mp,pointer p) { /* makes list of single-word nodes available */ - pointer q,r; /* list traversers */ - if ( p>=mp->hi_mem_min ) if ( p!=sentinel ) { - r=p; - do { - q=r; r=mp_link(r); - decr(mp->dyn_used); - if ( r<mp->hi_mem_min ) break; - } while (r!=sentinel); - /* now |q| is the last node on the list */ - mp_link(q)=mp->avail; mp->avail=p; - } -} -@# -static void mp_flush_node_list (MP mp,pointer p) { - pointer q; /* the node being recycled */ - while ( p!=null ){ - q=p; p=mp_link(p); - if ( q<mp->hi_mem_min ) - mp_free_node(mp, q,2); - else - free_avail(q); - } -} - -@ If \MP\ is extended improperly, the |mem| array might get screwed up. -For example, some pointers might be wrong, or some ``dead'' nodes might not -have been freed when the last reference to them disappeared. Procedures -|check_mem| and |search_mem| are available to help diagnose such -problems. These procedures make use of two arrays called |free| and -|was_free| that are present only if \MP's debugging routines have -been included. (You may want to decrease the size of |mem| while you -@^debugging@> -are debugging.) - -Because |boolean|s are typedef-d as ints, it is better to use -unsigned chars here. - -@<Glob...@>= -unsigned char *free; /* free cells */ -unsigned char *was_free; /* previously free cells */ -pointer was_mem_end; pointer was_lo_max; pointer was_hi_min; - /* previous |mem_end|, |lo_mem_max|,and |hi_mem_min| */ -boolean panicking; /* do we want to check memory constantly? */ - -@ @<Allocate or initialize ...@>= -mp->free = xmalloc ((mp->mem_max+1),sizeof (unsigned char)); -mp->was_free = xmalloc ((mp->mem_max+1), sizeof (unsigned char)); - -@ @<Dealloc variables@>= -xfree(mp->free); -xfree(mp->was_free); - -@ @<Allocate or ...@>= -mp->was_hi_min=mp->mem_max; -mp->panicking=false; - -@ @<Declarations@>= -static void mp_reallocate_memory(MP mp, int l) ; - -@ @c -static void mp_reallocate_memory(MP mp, int l) { - XREALLOC(mp->free, l, unsigned char); - XREALLOC(mp->was_free, l, unsigned char); - if (mp->mem) { - int newarea = l-mp->mem_max; - XREALLOC(mp->mem, l, memory_word); - memset (mp->mem+(mp->mem_max+1),0,sizeof(memory_word)*(newarea)); - } else { - XREALLOC(mp->mem, l, memory_word); - memset(mp->mem,0,sizeof(memory_word)*(l+1)); - } - mp->mem_max = l; - if (mp->ini_version) - mp->mem_top = l; -} - - - -@ Procedure |check_mem| makes sure that the available space lists of -|mem| are well formed, and it optionally prints out all locations -that are reserved now but were free the last time this procedure was called. - -@c -void mp_check_mem (MP mp,boolean print_locs ) { - pointer p,q,r; /* current locations of interest in |mem| */ - boolean clobbered; /* is something amiss? */ - for (p=0;p<=mp->lo_mem_max;p++) { - mp->free[p]=false; /* you can probably do this faster */ - } - for (p=mp->hi_mem_min;p<= mp->mem_end;p++) { - mp->free[p]=false; /* ditto */ - } - @<Check single-word |avail| list@>; - @<Check variable-size |avail| list@>; - @<Check flags of unavailable nodes@>; - @<Check the list of linear dependencies@>; - if ( print_locs ) { - @<Print newly busy locations@>; - } - memcpy(mp->was_free,mp->free, sizeof(char)*(mp->mem_end+1)); - mp->was_mem_end=mp->mem_end; - mp->was_lo_max=mp->lo_mem_max; - mp->was_hi_min=mp->hi_mem_min; -} - -@ @<Check single-word...@>= -p=mp->avail; q=null; clobbered=false; -while ( p!=null ) { - if ( (p>mp->mem_end)||(p<mp->hi_mem_min) ) clobbered=true; - else if ( mp->free[p] ) clobbered=true; - if ( clobbered ) { - mp_print_nl(mp, "AVAIL list clobbered at "); -@.AVAIL list clobbered...@> - mp_print_int(mp, q); break; - } - mp->free[p]=true; q=p; p=mp_link(q); -} - -@ @<Check variable-size...@>= -p=mp->rover; q=null; clobbered=false; -do { - if ( (p>=mp->lo_mem_max)||(p<0) ) clobbered=true; - else if ( (rmp_link(p)>=mp->lo_mem_max)||(rmp_link(p)<0) ) clobbered=true; - else if ( !(is_empty(p))||(node_size(p)<2)|| - (p+node_size(p)>mp->lo_mem_max)|| (lmp_link(rmp_link(p))!=p) ) clobbered=true; - if ( clobbered ) { - mp_print_nl(mp, "Double-AVAIL list clobbered at "); -@.Double-AVAIL list clobbered...@> - mp_print_int(mp, q); break; - } - for (q=p;q<=p+node_size(p)-1;q++) { /* mark all locations free */ - if ( mp->free[q] ) { - mp_print_nl(mp, "Doubly free location at "); -@.Doubly free location...@> - mp_print_int(mp, q); break; - } - mp->free[q]=true; - } - q=p; p=rmp_link(p); -} while (p!=mp->rover) - - -@ @<Check flags...@>= -p=0; -while ( p<=mp->lo_mem_max ) { /* node |p| should not be empty */ - if ( is_empty(p) ) { - mp_print_nl(mp, "Bad flag at "); mp_print_int(mp, p); -@.Bad flag...@> - } - while ( (p<=mp->lo_mem_max) && ! mp->free[p] ) p++; - while ( (p<=mp->lo_mem_max) && mp->free[p] ) p++; -} - -@ @<Print newly busy...@>= -{ - @<Do intialization required before printing new busy locations@>; - mp_print_nl(mp, "New busy locs:"); -@.New busy locs@> - for (p=0;p<= mp->lo_mem_max;p++ ) { - if ( ! mp->free[p] && ((p>mp->was_lo_max) || mp->was_free[p]) ) { - @<Indicate that |p| is a new busy location@>; - } - } - for (p=mp->hi_mem_min;p<=mp->mem_end;p++ ) { - if ( ! mp->free[p] && - ((p<mp->was_hi_min) || (p>mp->was_mem_end) || mp->was_free[p]) ) { - @<Indicate that |p| is a new busy location@>; - } - } - @<Finish printing new busy locations@>; -} - -@ There might be many new busy locations so we are careful to print contiguous -blocks compactly. During this operation |q| is the last new busy location and -|r| is the start of the block containing |q|. - -@<Indicate that |p| is a new busy location@>= -{ - if ( p>q+1 ) { - if ( q>r ) { - mp_print(mp, ".."); mp_print_int(mp, q); - } - mp_print_char(mp, xord(' ')); mp_print_int(mp, p); - r=p; - } - q=p; -} - -@ @<Do intialization required before printing new busy locations@>= -q=mp->mem_max; r=mp->mem_max - -@ @<Finish printing new busy locations@>= -if ( q>r ) { - mp_print(mp, ".."); mp_print_int(mp, q); -} - -@ The |search_mem| procedure attempts to answer the question ``Who points -to node~|p|?'' In doing so, it fetches |link| and |info| fields of |mem| -that might not be of type |two_halves|. Strictly speaking, this is -undefined, and it can lead to ``false drops'' (words that seem to -point to |p| purely by coincidence). But for debugging purposes, we want -to rule out the places that do {\sl not\/} point to |p|, so a few false -drops are tolerable. - -@c -void mp_search_mem (MP mp, pointer p) { /* look for pointers to |p| */ - integer q; /* current position being searched */ - for (q=0;q<=mp->lo_mem_max;q++) { - if ( mp_link(q)==p ){ - mp_print_nl(mp, "LINK("); mp_print_int(mp, q); mp_print_char(mp, xord(')')); - } - if ( mp_info(q)==p ) { - mp_print_nl(mp, "INFO("); mp_print_int(mp, q); mp_print_char(mp, xord(')')); - } - } - for (q=mp->hi_mem_min;q<=mp->mem_end;q++) { - if ( mp_link(q)==p ) { - mp_print_nl(mp, "LINK("); mp_print_int(mp, q); mp_print_char(mp, xord(')')); - } - if ( mp_info(q)==p ) { - mp_print_nl(mp, "INFO("); mp_print_int(mp, q); mp_print_char(mp, xord(')')); - } - } - @<Search |eqtb| for equivalents equal to |p|@>; -} - -@ Just before \.{INIMP} writes out the memory, it sorts the doubly linked -available space list. The list is probably very short at such times, so a -simple insertion sort is used. The smallest available location will be -pointed to by |rover|, the next-smallest by |rmp_link(rover)|, etc. - -@<Internal library ...@>= -void mp_sort_avail (MP mp); - -@ @c -void mp_sort_avail (MP mp) { /* sorts the available variable-size nodes - by location */ - pointer p,q,r; /* indices into |mem| */ - pointer old_rover; /* initial |rover| setting */ - p=mp_get_node(mp, 010000000000); /* merge adjacent free areas */ - p=rmp_link(mp->rover); rmp_link(mp->rover)=max_halfword; old_rover=mp->rover; - while ( p!=old_rover ) { - @<Sort |p| into the list starting at |rover| - and advance |p| to |rmp_link(p)|@>; - } - p=mp->rover; - while ( rmp_link(p)!=max_halfword ) { - lmp_link(rmp_link(p))=p; p=rmp_link(p); - }; - rmp_link(p)=mp->rover; lmp_link(mp->rover)=p; -} - -@ The following |while| loop is guaranteed to -terminate, since the list that starts at -|rover| ends with |max_halfword| during the sorting procedure. - -@<Sort |p|...@>= -if ( p<mp->rover ) { - q=p; p=rmp_link(q); rmp_link(q)=mp->rover; mp->rover=q; -} else { - q=mp->rover; - while ( rmp_link(q)<p ) q=rmp_link(q); - r=rmp_link(p); rmp_link(p)=rmp_link(q); rmp_link(q)=p; p=r; -} - - -@* \[12] The command codes. -Before we can go much further, we need to define symbolic names for the internal -code numbers that represent the various commands obeyed by \MP. These codes -are somewhat arbitrary, but not completely so. For example, -some codes have been made adjacent so that |case| statements in the -program need not consider cases that are widely spaced, or so that |case| -statements can be replaced by |if| statements. A command can begin an -expression if and only if its code lies between |min_primary_command| and -|max_primary_command|, inclusive. The first token of a statement that doesn't -begin with an expression has a command code between |min_command| and -|max_statement_command|, inclusive. Anything less than |min_command| is -eliminated during macro expansions, and anything no more than |max_pre_command| -is eliminated when expanding \TeX\ material. Ranges such as -|min_secondary_command..max_secondary_command| are used when parsing -expressions, but the relative ordering within such a range is generally not -critical. - -The ordering of the highest-numbered commands -(|comma<semicolon<end_group<stop|) is crucial for the parsing and -error-recovery methods of this program as is the ordering |if_test<fi_or_else| -for the smallest two commands. The ordering is also important in the ranges -|numeric_token..plus_or_minus| and |left_brace..ampersand|. - -At any rate, here is the list, for future reference. - -@d start_tex 1 /* begin \TeX\ material (\&{btex}, \&{verbatimtex}) */ -@d etex_marker 2 /* end \TeX\ material (\&{etex}) */ -@d mpx_break 3 /* stop reading an \.{MPX} file (\&{mpxbreak}) */ -@d max_pre_command mpx_break -@d if_test 4 /* conditional text (\&{if}) */ -@d fi_or_else 5 /* delimiters for conditionals (\&{elseif}, \&{else}, \&{fi}) */ -@d input 6 /* input a source file (\&{input}, \&{endinput}) */ -@d iteration 7 /* iterate (\&{for}, \&{forsuffixes}, \&{forever}, \&{endfor}) */ -@d repeat_loop 8 /* special command substituted for \&{endfor} */ -@d exit_test 9 /* premature exit from a loop (\&{exitif}) */ -@d relax 10 /* do nothing (\.{\char`\\}) */ -@d scan_tokens 11 /* put a string into the input buffer */ -@d expand_after 12 /* look ahead one token */ -@d defined_macro 13 /* a macro defined by the user */ -@d min_command (defined_macro+1) -@d save_command 14 /* save a list of tokens (\&{save}) */ -@d interim_command 15 /* save an internal quantity (\&{interim}) */ -@d let_command 16 /* redefine a symbolic token (\&{let}) */ -@d new_internal 17 /* define a new internal quantity (\&{newinternal}) */ -@d macro_def 18 /* define a macro (\&{def}, \&{vardef}, etc.) */ -@d ship_out_command 19 /* output a character (\&{shipout}) */ -@d add_to_command 20 /* add to edges (\&{addto}) */ -@d bounds_command 21 /* add bounding path to edges (\&{setbounds}, \&{clip}) */ -@d tfm_command 22 /* command for font metric info (\&{ligtable}, etc.) */ -@d protection_command 23 /* set protection flag (\&{outer}, \&{inner}) */ -@d show_command 24 /* diagnostic output (\&{show}, \&{showvariable}, etc.) */ -@d mode_command 25 /* set interaction level (\&{batchmode}, etc.) */ -@d mp_random_seed 26 /* initialize random number generator (\&{randomseed}) */ -@d message_command 27 /* communicate to user (\&{message}, \&{errmessage}) */ -@d every_job_command 28 /* designate a starting token (\&{everyjob}) */ -@d delimiters 29 /* define a pair of delimiters (\&{delimiters}) */ -@d special_command 30 /* output special info (\&{special}) - or font map info (\&{fontmapfile}, \&{fontmapline}) */ -@d write_command 31 /* write text to a file (\&{write}) */ -@d type_name 32 /* declare a type (\&{numeric}, \&{pair}, etc.) */ -@d max_statement_command type_name -@d min_primary_command type_name -@d left_delimiter 33 /* the left delimiter of a matching pair */ -@d begin_group 34 /* beginning of a group (\&{begingroup}) */ -@d nullary 35 /* an operator without arguments (e.g., \&{normaldeviate}) */ -@d unary 36 /* an operator with one argument (e.g., \&{sqrt}) */ -@d str_op 37 /* convert a suffix to a string (\&{str}) */ -@d cycle 38 /* close a cyclic path (\&{cycle}) */ -@d primary_binary 39 /* binary operation taking `\&{of}' (e.g., \&{point}) */ -@d capsule_token 40 /* a value that has been put into a token list */ -@d string_token 41 /* a string constant (e.g., |"hello"|) */ -@d internal_quantity 42 /* internal numeric parameter (e.g., \&{pausing}) */ -@d min_suffix_token internal_quantity -@d tag_token 43 /* a symbolic token without a primitive meaning */ -@d numeric_token 44 /* a numeric constant (e.g., \.{3.14159}) */ -@d max_suffix_token numeric_token -@d plus_or_minus 45 /* either `\.+' or `\.-' */ -@d max_primary_command plus_or_minus /* should also be |numeric_token+1| */ -@d min_tertiary_command plus_or_minus -@d tertiary_secondary_macro 46 /* a macro defined by \&{secondarydef} */ -@d tertiary_binary 47 /* an operator at the tertiary level (e.g., `\.{++}') */ -@d max_tertiary_command tertiary_binary -@d left_brace 48 /* the operator `\.{\char`\{}' */ -@d min_expression_command left_brace -@d path_join 49 /* the operator `\.{..}' */ -@d ampersand 50 /* the operator `\.\&' */ -@d expression_tertiary_macro 51 /* a macro defined by \&{tertiarydef} */ -@d expression_binary 52 /* an operator at the expression level (e.g., `\.<') */ -@d equals 53 /* the operator `\.=' */ -@d max_expression_command equals -@d and_command 54 /* the operator `\&{and}' */ -@d min_secondary_command and_command -@d secondary_primary_macro 55 /* a macro defined by \&{primarydef} */ -@d slash 56 /* the operator `\./' */ -@d secondary_binary 57 /* an operator at the binary level (e.g., \&{shifted}) */ -@d max_secondary_command secondary_binary -@d param_type 58 /* type of parameter (\&{primary}, \&{expr}, \&{suffix}, etc.) */ -@d controls 59 /* specify control points explicitly (\&{controls}) */ -@d tension 60 /* specify tension between knots (\&{tension}) */ -@d at_least 61 /* bounded tension value (\&{atleast}) */ -@d curl_command 62 /* specify curl at an end knot (\&{curl}) */ -@d macro_special 63 /* special macro operators (\&{quote}, \.{\#\AT!}, etc.) */ -@d right_delimiter 64 /* the right delimiter of a matching pair */ -@d left_bracket 65 /* the operator `\.[' */ -@d right_bracket 66 /* the operator `\.]' */ -@d right_brace 67 /* the operator `\.{\char`\}}' */ -@d with_option 68 /* option for filling (\&{withpen}, \&{withweight}, etc.) */ -@d thing_to_add 69 - /* variant of \&{addto} (\&{contour}, \&{doublepath}, \&{also}) */ -@d of_token 70 /* the operator `\&{of}' */ -@d to_token 71 /* the operator `\&{to}' */ -@d step_token 72 /* the operator `\&{step}' */ -@d until_token 73 /* the operator `\&{until}' */ -@d within_token 74 /* the operator `\&{within}' */ -@d lig_kern_token 75 - /* the operators `\&{kern}' and `\.{=:}' and `\.{=:\char'174}', etc. */ -@d assignment 76 /* the operator `\.{:=}' */ -@d skip_to 77 /* the operation `\&{skipto}' */ -@d bchar_label 78 /* the operator `\.{\char'174\char'174:}' */ -@d double_colon 79 /* the operator `\.{::}' */ -@d colon 80 /* the operator `\.:' */ -@# -@d comma 81 /* the operator `\.,', must be |colon+1| */ -@d end_of_statement (mp->cur_cmd>comma) -@d semicolon 82 /* the operator `\.;', must be |comma+1| */ -@d end_group 83 /* end a group (\&{endgroup}), must be |semicolon+1| */ -@d stop 84 /* end a job (\&{end}, \&{dump}), must be |end_group+1| */ -@d max_command_code stop -@d outer_tag (max_command_code+1) /* protection code added to command code */ - -@<Types...@>= -typedef int command_code; - -@ Variables and capsules in \MP\ have a variety of ``types,'' -distinguished by the code numbers defined here. These numbers are also -not completely arbitrary. Things that get expanded must have types -|>mp_independent|; a type remaining after expansion is numeric if and only if -its code number is at least |numeric_type|; objects containing numeric -parts must have types between |transform_type| and |pair_type|; -all other types must be smaller than |transform_type|; and among the types -that are not unknown or vacuous, the smallest two must be |boolean_type| -and |string_type| in that order. - -@d undefined 0 /* no type has been declared */ -@d unknown_tag 1 /* this constant is added to certain type codes below */ -@d unknown_types mp_unknown_boolean: case mp_unknown_string: - case mp_unknown_pen: case mp_unknown_picture: case mp_unknown_path - -@<Types...@>= -enum mp_variable_type { -mp_vacuous=1, /* no expression was present */ -mp_boolean_type, /* \&{boolean} with a known value */ -mp_unknown_boolean, -mp_string_type, /* \&{string} with a known value */ -mp_unknown_string, -mp_pen_type, /* \&{pen} with a known value */ -mp_unknown_pen, -mp_path_type, /* \&{path} with a known value */ -mp_unknown_path, -mp_picture_type, /* \&{picture} with a known value */ -mp_unknown_picture, -mp_transform_type, /* \&{transform} variable or capsule */ -mp_color_type, /* \&{color} variable or capsule */ -mp_cmykcolor_type, /* \&{cmykcolor} variable or capsule */ -mp_pair_type, /* \&{pair} variable or capsule */ -mp_numeric_type, /* variable that has been declared \&{numeric} but not used */ -mp_known, /* \&{numeric} with a known value */ -mp_dependent, /* a linear combination with |fraction| coefficients */ -mp_proto_dependent, /* a linear combination with |scaled| coefficients */ -mp_independent, /* \&{numeric} with unknown value */ -mp_token_list, /* variable name or suffix argument or text argument */ -mp_structured, /* variable with subscripts and attributes */ -mp_unsuffixed_macro, /* variable defined with \&{vardef} but no \.{\AT!\#} */ -mp_suffixed_macro /* variable defined with \&{vardef} and \.{\AT!\#} */ -} ; - -@ @<Declarations@>= -static void mp_print_type (MP mp,quarterword t) ; - -@ @<Basic printing procedures@>= -void mp_print_type (MP mp,quarterword t) { - switch (t) { - case mp_vacuous:mp_print(mp, "mp_vacuous"); break; - case mp_boolean_type:mp_print(mp, "boolean"); break; - case mp_unknown_boolean:mp_print(mp, "unknown boolean"); break; - case mp_string_type:mp_print(mp, "string"); break; - case mp_unknown_string:mp_print(mp, "unknown string"); break; - case mp_pen_type:mp_print(mp, "pen"); break; - case mp_unknown_pen:mp_print(mp, "unknown pen"); break; - case mp_path_type:mp_print(mp, "path"); break; - case mp_unknown_path:mp_print(mp, "unknown path"); break; - case mp_picture_type:mp_print(mp, "picture"); break; - case mp_unknown_picture:mp_print(mp, "unknown picture"); break; - case mp_transform_type:mp_print(mp, "transform"); break; - case mp_color_type:mp_print(mp, "color"); break; - case mp_cmykcolor_type:mp_print(mp, "cmykcolor"); break; - case mp_pair_type:mp_print(mp, "pair"); break; - case mp_known:mp_print(mp, "known numeric"); break; - case mp_dependent:mp_print(mp, "dependent"); break; - case mp_proto_dependent:mp_print(mp, "proto-dependent"); break; - case mp_numeric_type:mp_print(mp, "numeric"); break; - case mp_independent:mp_print(mp, "independent"); break; - case mp_token_list:mp_print(mp, "token list"); break; - case mp_structured:mp_print(mp, "mp_structured"); break; - case mp_unsuffixed_macro:mp_print(mp, "unsuffixed macro"); break; - case mp_suffixed_macro:mp_print(mp, "suffixed macro"); break; - default: mp_print(mp, "undefined"); break; - } -} - -@ Values inside \MP\ are stored in two-word nodes that have a |name_type| -as well as a |type|. The possibilities for |name_type| are defined -here; they will be explained in more detail later. - -@<Types...@>= -enum mp_name_types { - mp_root=0, /* |name_type| at the top level of a variable */ - mp_saved_root, /* same, when the variable has been saved */ - mp_structured_root, /* |name_type| where a |mp_structured| branch occurs */ - mp_subscr, /* |name_type| in a subscript node */ - mp_attr, /* |name_type| in an attribute node */ - mp_x_part_sector, /* |name_type| in the \&{xpart} of a node */ - mp_y_part_sector, /* |name_type| in the \&{ypart} of a node */ - mp_xx_part_sector, /* |name_type| in the \&{xxpart} of a node */ - mp_xy_part_sector, /* |name_type| in the \&{xypart} of a node */ - mp_yx_part_sector, /* |name_type| in the \&{yxpart} of a node */ - mp_yy_part_sector, /* |name_type| in the \&{yypart} of a node */ - mp_red_part_sector, /* |name_type| in the \&{redpart} of a node */ - mp_green_part_sector, /* |name_type| in the \&{greenpart} of a node */ - mp_blue_part_sector, /* |name_type| in the \&{bluepart} of a node */ - mp_cyan_part_sector, /* |name_type| in the \&{redpart} of a node */ - mp_magenta_part_sector, /* |name_type| in the \&{greenpart} of a node */ - mp_yellow_part_sector, /* |name_type| in the \&{bluepart} of a node */ - mp_black_part_sector, /* |name_type| in the \&{greenpart} of a node */ - mp_grey_part_sector, /* |name_type| in the \&{bluepart} of a node */ - mp_capsule, /* |name_type| in stashed-away subexpressions */ - mp_token /* |name_type| in a numeric token or string token */ -}; - -@ Primitive operations that produce values have a secondary identification -code in addition to their command code; it's something like genera and species. -For example, `\.*' has the command code |primary_binary|, and its -secondary identification is |times|. The secondary codes start at 30 so that -they don't overlap with the type codes; some type codes (e.g., |mp_string_type|) -are used as operators as well as type identifications. The relative values -are not critical, except for |true_code..false_code|, |or_op..and_op|, -and |filled_op..bounded_op|. The restrictions are that -|and_op-false_code=or_op-true_code|, that the ordering of -|x_part...blue_part| must match that of |x_part_sector..mp_blue_part_sector|, -and the ordering of |filled_op..bounded_op| must match that of the code -values they test for. - -@d true_code 30 /* operation code for \.{true} */ -@d false_code 31 /* operation code for \.{false} */ -@d null_picture_code 32 /* operation code for \.{nullpicture} */ -@d null_pen_code 33 /* operation code for \.{nullpen} */ -@d job_name_op 34 /* operation code for \.{jobname} */ -@d read_string_op 35 /* operation code for \.{readstring} */ -@d pen_circle 36 /* operation code for \.{pencircle} */ -@d normal_deviate 37 /* operation code for \.{normaldeviate} */ -@d read_from_op 38 /* operation code for \.{readfrom} */ -@d close_from_op 39 /* operation code for \.{closefrom} */ -@d odd_op 40 /* operation code for \.{odd} */ -@d known_op 41 /* operation code for \.{known} */ -@d unknown_op 42 /* operation code for \.{unknown} */ -@d not_op 43 /* operation code for \.{not} */ -@d decimal 44 /* operation code for \.{decimal} */ -@d reverse 45 /* operation code for \.{reverse} */ -@d make_path_op 46 /* operation code for \.{makepath} */ -@d make_pen_op 47 /* operation code for \.{makepen} */ -@d oct_op 48 /* operation code for \.{oct} */ -@d hex_op 49 /* operation code for \.{hex} */ -@d ASCII_op 50 /* operation code for \.{ASCII} */ -@d char_op 51 /* operation code for \.{char} */ -@d length_op 52 /* operation code for \.{length} */ -@d turning_op 53 /* operation code for \.{turningnumber} */ -@d color_model_part 54 /* operation code for \.{colormodel} */ -@d x_part 55 /* operation code for \.{xpart} */ -@d y_part 56 /* operation code for \.{ypart} */ -@d xx_part 57 /* operation code for \.{xxpart} */ -@d xy_part 58 /* operation code for \.{xypart} */ -@d yx_part 59 /* operation code for \.{yxpart} */ -@d yy_part 60 /* operation code for \.{yypart} */ -@d red_part 61 /* operation code for \.{redpart} */ -@d green_part 62 /* operation code for \.{greenpart} */ -@d blue_part 63 /* operation code for \.{bluepart} */ -@d cyan_part 64 /* operation code for \.{cyanpart} */ -@d magenta_part 65 /* operation code for \.{magentapart} */ -@d yellow_part 66 /* operation code for \.{yellowpart} */ -@d black_part 67 /* operation code for \.{blackpart} */ -@d grey_part 68 /* operation code for \.{greypart} */ -@d font_part 69 /* operation code for \.{fontpart} */ -@d text_part 70 /* operation code for \.{textpart} */ -@d path_part 71 /* operation code for \.{pathpart} */ -@d pen_part 72 /* operation code for \.{penpart} */ -@d dash_part 73 /* operation code for \.{dashpart} */ -@d sqrt_op 74 /* operation code for \.{sqrt} */ -@d mp_m_exp_op 75 /* operation code for \.{mexp} */ -@d mp_m_log_op 76 /* operation code for \.{mlog} */ -@d sin_d_op 77 /* operation code for \.{sind} */ -@d cos_d_op 78 /* operation code for \.{cosd} */ -@d floor_op 79 /* operation code for \.{floor} */ -@d uniform_deviate 80 /* operation code for \.{uniformdeviate} */ -@d char_exists_op 81 /* operation code for \.{charexists} */ -@d font_size 82 /* operation code for \.{fontsize} */ -@d ll_corner_op 83 /* operation code for \.{llcorner} */ -@d lr_corner_op 84 /* operation code for \.{lrcorner} */ -@d ul_corner_op 85 /* operation code for \.{ulcorner} */ -@d ur_corner_op 86 /* operation code for \.{urcorner} */ -@d arc_length 87 /* operation code for \.{arclength} */ -@d angle_op 88 /* operation code for \.{angle} */ -@d cycle_op 89 /* operation code for \.{cycle} */ -@d filled_op 90 /* operation code for \.{filled} */ -@d stroked_op 91 /* operation code for \.{stroked} */ -@d textual_op 92 /* operation code for \.{textual} */ -@d clipped_op 93 /* operation code for \.{clipped} */ -@d bounded_op 94 /* operation code for \.{bounded} */ -@d plus 95 /* operation code for \.+ */ -@d minus 96 /* operation code for \.- */ -@d times 97 /* operation code for \.* */ -@d over 98 /* operation code for \./ */ -@d pythag_add 99 /* operation code for \.{++} */ -@d pythag_sub 100 /* operation code for \.{+-+} */ -@d or_op 101 /* operation code for \.{or} */ -@d and_op 102 /* operation code for \.{and} */ -@d less_than 103 /* operation code for \.< */ -@d less_or_equal 104 /* operation code for \.{<=} */ -@d greater_than 105 /* operation code for \.> */ -@d greater_or_equal 106 /* operation code for \.{>=} */ -@d equal_to 107 /* operation code for \.= */ -@d unequal_to 108 /* operation code for \.{<>} */ -@d concatenate 109 /* operation code for \.\& */ -@d rotated_by 110 /* operation code for \.{rotated} */ -@d slanted_by 111 /* operation code for \.{slanted} */ -@d scaled_by 112 /* operation code for \.{scaled} */ -@d shifted_by 113 /* operation code for \.{shifted} */ -@d transformed_by 114 /* operation code for \.{transformed} */ -@d x_scaled 115 /* operation code for \.{xscaled} */ -@d y_scaled 116 /* operation code for \.{yscaled} */ -@d z_scaled 117 /* operation code for \.{zscaled} */ -@d in_font 118 /* operation code for \.{infont} */ -@d intersect 119 /* operation code for \.{intersectiontimes} */ -@d double_dot 120 /* operation code for improper \.{..} */ -@d substring_of 121 /* operation code for \.{substring} */ -@d min_of substring_of -@d subpath_of 122 /* operation code for \.{subpath} */ -@d direction_time_of 123 /* operation code for \.{directiontime} */ -@d point_of 124 /* operation code for \.{point} */ -@d precontrol_of 125 /* operation code for \.{precontrol} */ -@d postcontrol_of 126 /* operation code for \.{postcontrol} */ -@d pen_offset_of 127 /* operation code for \.{penoffset} */ -@d arc_time_of 128 /* operation code for \.{arctime} */ -@d mp_version 129 /* operation code for \.{mpversion} */ -@d envelope_of 130 /* operation code for \.{envelope} */ - -@c static void mp_print_op (MP mp,quarterword c) { - if (c<=mp_numeric_type ) { - mp_print_type(mp, c); - } else { - switch (c) { - case true_code:mp_print(mp, "true"); break; - case false_code:mp_print(mp, "false"); break; - case null_picture_code:mp_print(mp, "nullpicture"); break; - case null_pen_code:mp_print(mp, "nullpen"); break; - case job_name_op:mp_print(mp, "jobname"); break; - case read_string_op:mp_print(mp, "readstring"); break; - case pen_circle:mp_print(mp, "pencircle"); break; - case normal_deviate:mp_print(mp, "normaldeviate"); break; - case read_from_op:mp_print(mp, "readfrom"); break; - case close_from_op:mp_print(mp, "closefrom"); break; - case odd_op:mp_print(mp, "odd"); break; - case known_op:mp_print(mp, "known"); break; - case unknown_op:mp_print(mp, "unknown"); break; - case not_op:mp_print(mp, "not"); break; - case decimal:mp_print(mp, "decimal"); break; - case reverse:mp_print(mp, "reverse"); break; - case make_path_op:mp_print(mp, "makepath"); break; - case make_pen_op:mp_print(mp, "makepen"); break; - case oct_op:mp_print(mp, "oct"); break; - case hex_op:mp_print(mp, "hex"); break; - case ASCII_op:mp_print(mp, "ASCII"); break; - case char_op:mp_print(mp, "char"); break; - case length_op:mp_print(mp, "length"); break; - case turning_op:mp_print(mp, "turningnumber"); break; - case x_part:mp_print(mp, "xpart"); break; - case y_part:mp_print(mp, "ypart"); break; - case xx_part:mp_print(mp, "xxpart"); break; - case xy_part:mp_print(mp, "xypart"); break; - case yx_part:mp_print(mp, "yxpart"); break; - case yy_part:mp_print(mp, "yypart"); break; - case red_part:mp_print(mp, "redpart"); break; - case green_part:mp_print(mp, "greenpart"); break; - case blue_part:mp_print(mp, "bluepart"); break; - case cyan_part:mp_print(mp, "cyanpart"); break; - case magenta_part:mp_print(mp, "magentapart"); break; - case yellow_part:mp_print(mp, "yellowpart"); break; - case black_part:mp_print(mp, "blackpart"); break; - case grey_part:mp_print(mp, "greypart"); break; - case color_model_part:mp_print(mp, "colormodel"); break; - case font_part:mp_print(mp, "fontpart"); break; - case text_part:mp_print(mp, "textpart"); break; - case path_part:mp_print(mp, "pathpart"); break; - case pen_part:mp_print(mp, "penpart"); break; - case dash_part:mp_print(mp, "dashpart"); break; - case sqrt_op:mp_print(mp, "sqrt"); break; - case mp_m_exp_op:mp_print(mp, "mexp"); break; - case mp_m_log_op:mp_print(mp, "mlog"); break; - case sin_d_op:mp_print(mp, "sind"); break; - case cos_d_op:mp_print(mp, "cosd"); break; - case floor_op:mp_print(mp, "floor"); break; - case uniform_deviate:mp_print(mp, "uniformdeviate"); break; - case char_exists_op:mp_print(mp, "charexists"); break; - case font_size:mp_print(mp, "fontsize"); break; - case ll_corner_op:mp_print(mp, "llcorner"); break; - case lr_corner_op:mp_print(mp, "lrcorner"); break; - case ul_corner_op:mp_print(mp, "ulcorner"); break; - case ur_corner_op:mp_print(mp, "urcorner"); break; - case arc_length:mp_print(mp, "arclength"); break; - case angle_op:mp_print(mp, "angle"); break; - case cycle_op:mp_print(mp, "cycle"); break; - case filled_op:mp_print(mp, "filled"); break; - case stroked_op:mp_print(mp, "stroked"); break; - case textual_op:mp_print(mp, "textual"); break; - case clipped_op:mp_print(mp, "clipped"); break; - case bounded_op:mp_print(mp, "bounded"); break; - case plus:mp_print_char(mp, xord('+')); break; - case minus:mp_print_char(mp, xord('-')); break; - case times:mp_print_char(mp, xord('*')); break; - case over:mp_print_char(mp, xord('/')); break; - case pythag_add:mp_print(mp, "++"); break; - case pythag_sub:mp_print(mp, "+-+"); break; - case or_op:mp_print(mp, "or"); break; - case and_op:mp_print(mp, "and"); break; - case less_than:mp_print_char(mp, xord('<')); break; - case less_or_equal:mp_print(mp, "<="); break; - case greater_than:mp_print_char(mp, xord('>')); break; - case greater_or_equal:mp_print(mp, ">="); break; - case equal_to:mp_print_char(mp, xord('=')); break; - case unequal_to:mp_print(mp, "<>"); break; - case concatenate:mp_print(mp, "&"); break; - case rotated_by:mp_print(mp, "rotated"); break; - case slanted_by:mp_print(mp, "slanted"); break; - case scaled_by:mp_print(mp, "scaled"); break; - case shifted_by:mp_print(mp, "shifted"); break; - case transformed_by:mp_print(mp, "transformed"); break; - case x_scaled:mp_print(mp, "xscaled"); break; - case y_scaled:mp_print(mp, "yscaled"); break; - case z_scaled:mp_print(mp, "zscaled"); break; - case in_font:mp_print(mp, "infont"); break; - case intersect:mp_print(mp, "intersectiontimes"); break; - case substring_of:mp_print(mp, "substring"); break; - case subpath_of:mp_print(mp, "subpath"); break; - case direction_time_of:mp_print(mp, "directiontime"); break; - case point_of:mp_print(mp, "point"); break; - case precontrol_of:mp_print(mp, "precontrol"); break; - case postcontrol_of:mp_print(mp, "postcontrol"); break; - case pen_offset_of:mp_print(mp, "penoffset"); break; - case arc_time_of:mp_print(mp, "arctime"); break; - case mp_version:mp_print(mp, "mpversion"); break; - case envelope_of:mp_print(mp, "envelope"); break; - default: mp_print(mp, ".."); break; - } - } -} - -@ \MP\ also has a bunch of internal parameters that a user might want to -fuss with. Every such parameter has an identifying code number, defined here. - -@<Types...@>= -enum mp_given_internal { - mp_tracing_titles=1, /* show titles online when they appear */ - mp_tracing_equations, /* show each variable when it becomes known */ - mp_tracing_capsules, /* show capsules too */ - mp_tracing_choices, /* show the control points chosen for paths */ - mp_tracing_specs, /* show path subdivision prior to filling with polygonal a pen */ - mp_tracing_commands, /* show commands and operations before they are performed */ - mp_tracing_restores, /* show when a variable or internal is restored */ - mp_tracing_macros, /* show macros before they are expanded */ - mp_tracing_output, /* show digitized edges as they are output */ - mp_tracing_stats, /* show memory usage at end of job */ - mp_tracing_lost_chars, /* show characters that aren't \&{infont} */ - mp_tracing_online, /* show long diagnostics on terminal and in the log file */ - mp_year, /* the current year (e.g., 1984) */ - mp_month, /* the current month (e.g., 3 $\equiv$ March) */ - mp_day, /* the current day of the month */ - mp_time, /* the number of minutes past midnight when this job started */ - mp_char_code, /* the number of the next character to be output */ - mp_char_ext, /* the extension code of the next character to be output */ - mp_char_wd, /* the width of the next character to be output */ - mp_char_ht, /* the height of the next character to be output */ - mp_char_dp, /* the depth of the next character to be output */ - mp_char_ic, /* the italic correction of the next character to be output */ - mp_design_size, /* the unit of measure used for |mp_char_wd..mp_char_ic|, in points */ - mp_pausing, /* positive to display lines on the terminal before they are read */ - mp_showstopping, /* positive to stop after each \&{show} command */ - mp_fontmaking, /* positive if font metric output is to be produced */ - mp_linejoin, /* as in \ps: 0 for mitered, 1 for round, 2 for beveled */ - mp_linecap, /* as in \ps: 0 for butt, 1 for round, 2 for square */ - mp_miterlimit, /* controls miter length as in \ps */ - mp_warning_check, /* controls error message when variable value is large */ - mp_boundary_char, /* the right boundary character for ligatures */ - mp_prologues, /* positive to output conforming PostScript using built-in fonts */ - mp_true_corners, /* positive to make \&{llcorner} etc. ignore \&{setbounds} */ - mp_default_color_model, /* the default color model for unspecified items */ - mp_restore_clip_color, - mp_procset, /* wether or not create PostScript command shortcuts */ - mp_gtroffmode /* whether the user specified |-troff| on the command line */ -}; - -@ - -@d max_given_internal mp_gtroffmode - -@<Glob...@>= -scaled *internal; /* the values of internal quantities */ -char **int_name; /* their names */ -int int_ptr; /* the maximum internal quantity defined so far */ -int max_internal; /* current maximum number of internal quantities */ - -@ @<Option variables@>= -int troff_mode; - -@ @<Allocate or initialize ...@>= -mp->max_internal=2*max_given_internal; -mp->internal = xmalloc ((mp->max_internal+1), sizeof(scaled)); -memset(mp->internal,0,(mp->max_internal+1)* sizeof(scaled)); -mp->int_name = xmalloc ((mp->max_internal+1), sizeof(char *)); -memset(mp->int_name,0,(mp->max_internal+1) * sizeof(char *)); -mp->troff_mode=(opt->troff_mode>0 ? true : false); - -@ @<Exported function ...@>= -int mp_troff_mode(MP mp); - -@ @c -int mp_troff_mode(MP mp) { return mp->troff_mode; } - -@ @<Set initial ...@>= -mp->int_ptr=max_given_internal; - -@ The symbolic names for internal quantities are put into \MP's hash table -by using a routine called |primitive|, which will be defined later. Let us -enter them now, so that we don't have to list all those names again -anywhere else. - -@<Put each of \MP's primitives into the hash table@>= -mp_primitive(mp, "tracingtitles",internal_quantity,mp_tracing_titles); -@:tracingtitles_}{\&{tracingtitles} primitive@> -mp_primitive(mp, "tracingequations",internal_quantity,mp_tracing_equations); -@:mp_tracing_equations_}{\&{tracingequations} primitive@> -mp_primitive(mp, "tracingcapsules",internal_quantity,mp_tracing_capsules); -@:mp_tracing_capsules_}{\&{tracingcapsules} primitive@> -mp_primitive(mp, "tracingchoices",internal_quantity,mp_tracing_choices); -@:mp_tracing_choices_}{\&{tracingchoices} primitive@> -mp_primitive(mp, "tracingspecs",internal_quantity,mp_tracing_specs); -@:mp_tracing_specs_}{\&{tracingspecs} primitive@> -mp_primitive(mp, "tracingcommands",internal_quantity,mp_tracing_commands); -@:mp_tracing_commands_}{\&{tracingcommands} primitive@> -mp_primitive(mp, "tracingrestores",internal_quantity,mp_tracing_restores); -@:mp_tracing_restores_}{\&{tracingrestores} primitive@> -mp_primitive(mp, "tracingmacros",internal_quantity,mp_tracing_macros); -@:mp_tracing_macros_}{\&{tracingmacros} primitive@> -mp_primitive(mp, "tracingoutput",internal_quantity,mp_tracing_output); -@:mp_tracing_output_}{\&{tracingoutput} primitive@> -mp_primitive(mp, "tracingstats",internal_quantity,mp_tracing_stats); -@:mp_tracing_stats_}{\&{tracingstats} primitive@> -mp_primitive(mp, "tracinglostchars",internal_quantity,mp_tracing_lost_chars); -@:mp_tracing_lost_chars_}{\&{tracinglostchars} primitive@> -mp_primitive(mp, "tracingonline",internal_quantity,mp_tracing_online); -@:mp_tracing_online_}{\&{tracingonline} primitive@> -mp_primitive(mp, "year",internal_quantity,mp_year); -@:mp_year_}{\&{year} primitive@> -mp_primitive(mp, "month",internal_quantity,mp_month); -@:mp_month_}{\&{month} primitive@> -mp_primitive(mp, "day",internal_quantity,mp_day); -@:mp_day_}{\&{day} primitive@> -mp_primitive(mp, "time",internal_quantity,mp_time); -@:time_}{\&{time} primitive@> -mp_primitive(mp, "charcode",internal_quantity,mp_char_code); -@:mp_char_code_}{\&{charcode} primitive@> -mp_primitive(mp, "charext",internal_quantity,mp_char_ext); -@:mp_char_ext_}{\&{charext} primitive@> -mp_primitive(mp, "charwd",internal_quantity,mp_char_wd); -@:mp_char_wd_}{\&{charwd} primitive@> -mp_primitive(mp, "charht",internal_quantity,mp_char_ht); -@:mp_char_ht_}{\&{charht} primitive@> -mp_primitive(mp, "chardp",internal_quantity,mp_char_dp); -@:mp_char_dp_}{\&{chardp} primitive@> -mp_primitive(mp, "charic",internal_quantity,mp_char_ic); -@:mp_char_ic_}{\&{charic} primitive@> -mp_primitive(mp, "designsize",internal_quantity,mp_design_size); -@:mp_design_size_}{\&{designsize} primitive@> -mp_primitive(mp, "pausing",internal_quantity,mp_pausing); -@:mp_pausing_}{\&{pausing} primitive@> -mp_primitive(mp, "showstopping",internal_quantity,mp_showstopping); -@:mp_showstopping_}{\&{showstopping} primitive@> -mp_primitive(mp, "fontmaking",internal_quantity,mp_fontmaking); -@:mp_fontmaking_}{\&{fontmaking} primitive@> -mp_primitive(mp, "linejoin",internal_quantity,mp_linejoin); -@:mp_linejoin_}{\&{linejoin} primitive@> -mp_primitive(mp, "linecap",internal_quantity,mp_linecap); -@:mp_linecap_}{\&{linecap} primitive@> -mp_primitive(mp, "miterlimit",internal_quantity,mp_miterlimit); -@:mp_miterlimit_}{\&{miterlimit} primitive@> -mp_primitive(mp, "warningcheck",internal_quantity,mp_warning_check); -@:mp_warning_check_}{\&{warningcheck} primitive@> -mp_primitive(mp, "boundarychar",internal_quantity,mp_boundary_char); -@:mp_boundary_char_}{\&{boundarychar} primitive@> -mp_primitive(mp, "prologues",internal_quantity,mp_prologues); -@:mp_prologues_}{\&{prologues} primitive@> -mp_primitive(mp, "truecorners",internal_quantity,mp_true_corners); -@:mp_true_corners_}{\&{truecorners} primitive@> -mp_primitive(mp, "mpprocset",internal_quantity,mp_procset); -@:mp_procset_}{\&{mpprocset} primitive@> -mp_primitive(mp, "troffmode",internal_quantity,mp_gtroffmode); -@:troffmode_}{\&{troffmode} primitive@> -mp_primitive(mp, "defaultcolormodel",internal_quantity,mp_default_color_model); -@:mp_default_color_model_}{\&{defaultcolormodel} primitive@> -mp_primitive(mp, "restoreclipcolor",internal_quantity,mp_restore_clip_color); -@:mp_restore_clip_color_}{\&{restoreclipcolor} primitive@> - -@ Colors can be specified in four color models. In the special -case of |no_model|, MetaPost does not output any color operator to -the postscript output. - -Note: these values are passed directly on to |with_option|. This only -works because the other possible values passed to |with_option| are -8 and 10 respectively (from |with_pen| and |with_picture|). - -There is a first state, that is only used for |gs_colormodel|. It flags -the fact that there has not been any kind of color specification by -the user so far in the game. - -@(mplib.h@>= -enum mp_color_model { - mp_no_model=1, - mp_grey_model=3, - mp_rgb_model=5, - mp_cmyk_model=7, - mp_uninitialized_model=9 -}; - - -@ @<Initialize table entries (done by \.{INIMP} only)@>= -mp->internal[mp_default_color_model]=(mp_rgb_model*unity); -mp->internal[mp_restore_clip_color]=unity; - -@ Well, we do have to list the names one more time, for use in symbolic -printouts. - -@<Initialize table...@>= -mp->int_name[mp_tracing_titles]=xstrdup("tracingtitles"); -mp->int_name[mp_tracing_equations]=xstrdup("tracingequations"); -mp->int_name[mp_tracing_capsules]=xstrdup("tracingcapsules"); -mp->int_name[mp_tracing_choices]=xstrdup("tracingchoices"); -mp->int_name[mp_tracing_specs]=xstrdup("tracingspecs"); -mp->int_name[mp_tracing_commands]=xstrdup("tracingcommands"); -mp->int_name[mp_tracing_restores]=xstrdup("tracingrestores"); -mp->int_name[mp_tracing_macros]=xstrdup("tracingmacros"); -mp->int_name[mp_tracing_output]=xstrdup("tracingoutput"); -mp->int_name[mp_tracing_stats]=xstrdup("tracingstats"); -mp->int_name[mp_tracing_lost_chars]=xstrdup("tracinglostchars"); -mp->int_name[mp_tracing_online]=xstrdup("tracingonline"); -mp->int_name[mp_year]=xstrdup("year"); -mp->int_name[mp_month]=xstrdup("month"); -mp->int_name[mp_day]=xstrdup("day"); -mp->int_name[mp_time]=xstrdup("time"); -mp->int_name[mp_char_code]=xstrdup("charcode"); -mp->int_name[mp_char_ext]=xstrdup("charext"); -mp->int_name[mp_char_wd]=xstrdup("charwd"); -mp->int_name[mp_char_ht]=xstrdup("charht"); -mp->int_name[mp_char_dp]=xstrdup("chardp"); -mp->int_name[mp_char_ic]=xstrdup("charic"); -mp->int_name[mp_design_size]=xstrdup("designsize"); -mp->int_name[mp_pausing]=xstrdup("pausing"); -mp->int_name[mp_showstopping]=xstrdup("showstopping"); -mp->int_name[mp_fontmaking]=xstrdup("fontmaking"); -mp->int_name[mp_linejoin]=xstrdup("linejoin"); -mp->int_name[mp_linecap]=xstrdup("linecap"); -mp->int_name[mp_miterlimit]=xstrdup("miterlimit"); -mp->int_name[mp_warning_check]=xstrdup("warningcheck"); -mp->int_name[mp_boundary_char]=xstrdup("boundarychar"); -mp->int_name[mp_prologues]=xstrdup("prologues"); -mp->int_name[mp_true_corners]=xstrdup("truecorners"); -mp->int_name[mp_default_color_model]=xstrdup("defaultcolormodel"); -mp->int_name[mp_procset]=xstrdup("mpprocset"); -mp->int_name[mp_gtroffmode]=xstrdup("troffmode"); -mp->int_name[mp_restore_clip_color]=xstrdup("restoreclipcolor"); - -@ The following procedure, which is called just before \MP\ initializes its -input and output, establishes the initial values of the date and time. -@^system dependencies@> - -Note that the values are |scaled| integers. Hence \MP\ can no longer -be used after the year 32767. - -@c -static void mp_fix_date_and_time (MP mp) { - time_t aclock = time ((time_t *) 0); - struct tm *tmptr = localtime (&aclock); - mp->internal[mp_time]= - (tmptr->tm_hour*60+tmptr->tm_min)*unity; /* minutes since midnight */ - mp->internal[mp_day]=(tmptr->tm_mday)*unity; /* fourth day of the month */ - mp->internal[mp_month]=(tmptr->tm_mon+1)*unity; /* seventh month of the year */ - mp->internal[mp_year]=(tmptr->tm_year+1900)*unity; /* Anno Domini */ -} - -@ @<Declarations@>= -static void mp_fix_date_and_time (MP mp) ; - -@ \MP\ is occasionally supposed to print diagnostic information that -goes only into the transcript file, unless |mp_tracing_online| is positive. -Now that we have defined |mp_tracing_online| we can define -two routines that adjust the destination of print commands: - -@<Declarations@>= -static void mp_begin_diagnostic (MP mp) ; -static void mp_end_diagnostic (MP mp,boolean blank_line); -static void mp_print_diagnostic (MP mp, const char *s, const char *t, boolean nuline) ; - -@ @<Basic printing...@>= -void mp_begin_diagnostic (MP mp) { /* prepare to do some tracing */ - mp->old_setting=mp->selector; - if ((mp->internal[mp_tracing_online]<=0)&&(mp->selector==term_and_log)){ - decr(mp->selector); - if ( mp->history==mp_spotless ) mp->history=mp_warning_issued; - } -} -@# -void mp_end_diagnostic (MP mp,boolean blank_line) { - /* restore proper conditions after tracing */ - mp_print_nl(mp, ""); - if ( blank_line ) mp_print_ln(mp); - mp->selector=mp->old_setting; -} - -@ - -@<Glob...@>= -unsigned int old_setting; - -@ We will occasionally use |begin_diagnostic| in connection with line-number -printing, as follows. (The parameter |s| is typically |"Path"| or -|"Cycle spec"|, etc.) - -@<Basic printing...@>= -void mp_print_diagnostic (MP mp, const char *s, const char *t, boolean nuline) { - mp_begin_diagnostic(mp); - if ( nuline ) mp_print_nl(mp, s); else mp_print(mp, s); - mp_print(mp, " at line "); - mp_print_int(mp, mp_true_line(mp)); - mp_print(mp, t); mp_print_char(mp, xord(':')); -} - -@ The 256 |ASCII_code| characters are grouped into classes by means of -the |char_class| table. Individual class numbers have no semantic -or syntactic significance, except in a few instances defined here. -There's also |max_class|, which can be used as a basis for additional -class numbers in nonstandard extensions of \MP. - -@d digit_class 0 /* the class number of \.{0123456789} */ -@d period_class 1 /* the class number of `\..' */ -@d space_class 2 /* the class number of spaces and nonstandard characters */ -@d percent_class 3 /* the class number of `\.\%' */ -@d string_class 4 /* the class number of `\."' */ -@d right_paren_class 8 /* the class number of `\.)' */ -@d isolated_classes 5: case 6: case 7: case 8 /* characters that make length-one tokens only */ -@d letter_class 9 /* letters and the underline character */ -@d left_bracket_class 17 /* `\.[' */ -@d right_bracket_class 18 /* `\.]' */ -@d invalid_class 20 /* bad character in the input */ -@d max_class 20 /* the largest class number */ - -@<Glob...@>= -int char_class[256]; /* the class numbers */ - -@ If changes are made to accommodate non-ASCII character sets, they should -follow the guidelines in Appendix~C of {\sl The {\logos METAFONT\/}book}. -@:METAFONTbook}{\sl The {\logos METAFONT\/}book@> -@^system dependencies@> - -@<Set initial ...@>= -for (k='0';k<='9';k++) - mp->char_class[k]=digit_class; -mp->char_class['.']=period_class; -mp->char_class[' ']=space_class; -mp->char_class['%']=percent_class; -mp->char_class['"']=string_class; -mp->char_class[',']=5; -mp->char_class[';']=6; -mp->char_class['(']=7; -mp->char_class[')']=right_paren_class; -for (k='A';k<= 'Z';k++ ) - mp->char_class[k]=letter_class; -for (k='a';k<='z';k++) - mp->char_class[k]=letter_class; -mp->char_class['_']=letter_class; -mp->char_class['<']=10; -mp->char_class['=']=10; -mp->char_class['>']=10; -mp->char_class[':']=10; -mp->char_class['|']=10; -mp->char_class['`']=11; -mp->char_class['\'']=11; -mp->char_class['+']=12; -mp->char_class['-']=12; -mp->char_class['/']=13; -mp->char_class['*']=13; -mp->char_class['\\']=13; -mp->char_class['!']=14; -mp->char_class['?']=14; -mp->char_class['#']=15; -mp->char_class['&']=15; -mp->char_class['@@']=15; -mp->char_class['$']=15; -mp->char_class['^']=16; -mp->char_class['~']=16; -mp->char_class['[']=left_bracket_class; -mp->char_class[']']=right_bracket_class; -mp->char_class['{']=19; -mp->char_class['}']=19; -for (k=0;k<' ';k++) - mp->char_class[k]=invalid_class; -mp->char_class['\t']=space_class; -mp->char_class['\f']=space_class; -for (k=127;k<=255;k++) - mp->char_class[k]=invalid_class; - -@* \[13] The hash table. -Symbolic tokens are stored and retrieved by means of a fairly standard hash -table algorithm called the method of ``coalescing lists'' (cf.\ Algorithm 6.4C -in {\sl The Art of Computer Programming\/}). Once a symbolic token enters the -table, it is never removed. - -The actual sequence of characters forming a symbolic token is -stored in the |str_pool| array together with all the other strings. An -auxiliary array |hash| consists of items with two halfword fields per -word. The first of these, called |mp_next(p)|, points to the next identifier -belonging to the same coalesced list as the identifier corresponding to~|p|; -and the other, called |text(p)|, points to the |str_start| entry for -|p|'s identifier. If position~|p| of the hash table is empty, we have -|text(p)=0|; if position |p| is either empty or the end of a coalesced -hash list, we have |mp_next(p)=0|. - -An auxiliary pointer variable called |hash_used| is maintained in such a -way that all locations |p>=hash_used| are nonempty. The global variable -|st_count| tells how many symbolic tokens have been defined, if statistics -are being kept. - -The first 256 locations of |hash| are reserved for symbols of length one. - -There's a parallel array called |eqtb| that contains the current equivalent -values of each symbolic token. The entries of this array consist of -two halfwords called |eq_type| (a command code) and |equiv| (a secondary -piece of information that qualifies the |eq_type|). - -@d eq_type(A) mp->eqtb[(A)].lh /* the current ``meaning'' of a symbolic token */ -@d equiv(A) mp->eqtb[(A)].rh /* parametric part of a token's meaning */ -@d hash_is_full (mp->hash_used==hash_base) /* are all positions occupied? */ - -@(mpmp.h@>= -#define mp_next(A) mp->hash[(A)].lh /* link for coalesced lists */ -#define text(A) mp->hash[(A)].rh /* string number for symbolic token name */ -#define hash_base 257 /* hashing actually starts here */ - -@ @<Glob...@>= -pointer hash_used; /* allocation pointer for |hash| */ -integer st_count; /* total number of known identifiers */ - -@ Certain entries in the hash table are ``frozen'' and not redefinable, -since they are used in error recovery. - -@(mpmp.h@>= -#define hash_top (integer)(hash_base+mp->hash_size) /* the first location of the frozen area */ -#define frozen_inaccessible hash_top /* |hash| location to protect the frozen area */ -#define frozen_repeat_loop (hash_top+1) /* |hash| location of a loop-repeat token */ -#define frozen_right_delimiter (hash_top+2) /* |hash| location of a permanent `\.)' */ -#define frozen_left_bracket (hash_top+3) /* |hash| location of a permanent `\.[' */ -#define frozen_slash (hash_top+4) /* |hash| location of a permanent `\./' */ -#define frozen_colon (hash_top+5) /* |hash| location of a permanent `\.:' */ -#define frozen_semicolon (hash_top+6) /* |hash| location of a permanent `\.;' */ -#define frozen_end_for (hash_top+7) /* |hash| location of a permanent \&{endfor} */ -#define frozen_end_def (hash_top+8) /* |hash| location of a permanent \&{enddef} */ -#define frozen_fi (hash_top+9) /* |hash| location of a permanent \&{fi} */ -#define frozen_end_group (hash_top+10) /* |hash| location of a permanent `\.{endgroup}' */ -#define frozen_etex (hash_top+11) /* |hash| location of a permanent \&{etex} */ -#define frozen_mpx_break (hash_top+12) /* |hash| location of a permanent \&{mpxbreak} */ -#define frozen_bad_vardef (hash_top+13) /* |hash| location of `\.{a bad variable}' */ -#define frozen_undefined (hash_top+14) /* |hash| location that never gets defined */ -#define hash_end (integer)(hash_top+14) /* the actual size of the |hash| and |eqtb| arrays */ - - -@ @<Glob...@>= -two_halves *hash; /* the hash table */ -two_halves *eqtb; /* the equivalents */ - -@ @<Allocate or initialize ...@>= -mp->hash = xmalloc((hash_end+1),sizeof(two_halves)); -mp->eqtb = xmalloc((hash_end+1),sizeof(two_halves)); - -@ @<Dealloc variables@>= -xfree(mp->hash); -xfree(mp->eqtb); - -@ @<Set init...@>= -mp_next(1)=0; text(1)=0; eq_type(1)=tag_token; equiv(1)=null; -for (k=2;k<=hash_end;k++) { - mp->hash[k]=mp->hash[1]; mp->eqtb[k]=mp->eqtb[1]; -} - -@ @<Initialize table entries...@>= -mp->hash_used=frozen_inaccessible; /* nothing is used */ -mp->st_count=0; -text(frozen_bad_vardef)=intern("a bad variable"); -text(frozen_etex)=intern("etex"); -text(frozen_mpx_break)=intern("mpxbreak"); -text(frozen_fi)=intern("fi"); -text(frozen_end_group)=intern("endgroup"); -text(frozen_end_def)=intern("enddef"); -text(frozen_end_for)=intern("endfor"); -text(frozen_semicolon)=intern(";"); -text(frozen_colon)=intern(":"); -text(frozen_slash)=intern("/"); -text(frozen_left_bracket)=intern("["); -text(frozen_right_delimiter)=intern(")"); -text(frozen_inaccessible)=intern(" INACCESSIBLE"); -eq_type(frozen_right_delimiter)=right_delimiter; - -@ @<Check the ``constant'' values...@>= -if ( hash_end+mp->max_internal>max_halfword ) mp->bad=17; - -@ Here is the subroutine that searches the hash table for an identifier -that matches a given string of length~|l| appearing in |buffer[j.. -(j+l-1)]|. If the identifier is not found, it is inserted; hence it -will always be found, and the corresponding hash table address -will be returned. - -@c -static pointer mp_id_lookup (MP mp,integer j, integer l) { /* search the hash table */ - integer h; /* hash code */ - pointer p; /* index in |hash| array */ - pointer k; /* index in |buffer| array */ - if (l==1) { - @<Treat special case of length 1 and |break|@>; - } - @<Compute the hash code |h|@>; - p=h+hash_base; /* we start searching here; note that |0<=h<hash_prime| */ - while (true) { - if (text(p)>0 && length(text(p))==l && mp_str_eq_buf(mp, text(p),j)) - break; - if ( mp_next(p)==0 ) { - @<Insert a new symbolic token after |p|, then - make |p| point to it and |break|@>; - } - p=mp_next(p); - } - return p; -} - -@ @<Treat special case of length 1...@>= - p=mp->buffer[j]+1; text(p)=p-1; return p; - - -@ @<Insert a new symbolic...@>= -{ -if ( text(p)>0 ) { - do { - if ( hash_is_full ) - mp_overflow(mp, "hash size",(integer)mp->hash_size); -@:MetaPost capacity exceeded hash size}{\quad hash size@> - decr(mp->hash_used); - } while (text(mp->hash_used)!=0); /* search for an empty location in |hash| */ - mp_next(p)=mp->hash_used; - p=mp->hash_used; -} -str_room(l); -for (k=j;k<j+l;k++) { - append_char(mp->buffer[k]); -} -text(p)=mp_make_string(mp); -mp->str_ref[text(p)]=max_str_ref; -incr(mp->st_count); -break; -} - - -@ The value of |hash_prime| should be roughly 85\pct! of |hash_size|, and it -should be a prime number. The theory of hashing tells us to expect fewer -than two table probes, on the average, when the search is successful. -[See J.~S. Vitter, {\sl Journal of the ACM\/ \bf30} (1983), 231--258.] -@^Vitter, Jeffrey Scott@> - -@<Compute the hash code |h|@>= -h=mp->buffer[j]; -for (k=j+1;k<j+l;k++){ - h=h+h+mp->buffer[k]; - while ( h>=mp->hash_prime ) h=h-mp->hash_prime; -} - -@ @<Search |eqtb| for equivalents equal to |p|@>= -for (q=1;q<=hash_end;q++) { - if ( equiv(q)==p ) { - mp_print_nl(mp, "EQUIV("); - mp_print_int(mp, q); - mp_print_char(mp, xord(')')); - } -} - -@ We need to put \MP's ``primitive'' symbolic tokens into the hash -table, together with their command code (which will be the |eq_type|) -and an operand (which will be the |equiv|). The |primitive| procedure -does this, in a way that no \MP\ user can. The global value |cur_sym| -contains the new |eqtb| pointer after |primitive| has acted. - -@c -static void mp_primitive (MP mp, const char *ss, halfword c, halfword o) { - pool_pointer k; /* index into |str_pool| */ - quarterword j; /* index into |buffer| */ - quarterword l; /* length of the string */ - str_number s; - s = intern(ss); - k=mp->str_start[s]; l=str_stop(s)-k; - /* we will move |s| into the (empty) |buffer| */ - for (j=0;j<=l-1;j++) { - mp->buffer[j]=mp->str_pool[k+j]; - } - mp->cur_sym=mp_id_lookup(mp, 0,l); - if ( s>=256 ) { /* we don't want to have the string twice */ - mp_flush_string(mp, text(mp->cur_sym)); text(mp->cur_sym)=s; - }; - eq_type(mp->cur_sym)=c; - equiv(mp->cur_sym)=o; -} - - -@ Many of \MP's primitives need no |equiv|, since they are identifiable -by their |eq_type| alone. These primitives are loaded into the hash table -as follows: - -@<Put each of \MP's primitives into the hash table@>= -mp_primitive(mp, "..",path_join,0); -@:.._}{\.{..} primitive@> -mp_primitive(mp, "[",left_bracket,0); mp->eqtb[frozen_left_bracket]=mp->eqtb[mp->cur_sym]; -@:[ }{\.{[} primitive@> -mp_primitive(mp, "]",right_bracket,0); -@:] }{\.{]} primitive@> -mp_primitive(mp, "}",right_brace,0); -@:]]}{\.{\char`\}} primitive@> -mp_primitive(mp, "{",left_brace,0); -@:][}{\.{\char`\{} primitive@> -mp_primitive(mp, ":",colon,0); mp->eqtb[frozen_colon]=mp->eqtb[mp->cur_sym]; -@:: }{\.{:} primitive@> -mp_primitive(mp, "::",double_colon,0); -@::: }{\.{::} primitive@> -mp_primitive(mp, "||:",bchar_label,0); -@:::: }{\.{\char'174\char'174:} primitive@> -mp_primitive(mp, ":=",assignment,0); -@::=_}{\.{:=} primitive@> -mp_primitive(mp, ",",comma,0); -@:, }{\., primitive@> -mp_primitive(mp, ";",semicolon,0); mp->eqtb[frozen_semicolon]=mp->eqtb[mp->cur_sym]; -@:; }{\.; primitive@> -mp_primitive(mp, "\\",relax,0); -@:]]\\}{\.{\char`\\} primitive@> -@# -mp_primitive(mp, "addto",add_to_command,0); -@:add_to_}{\&{addto} primitive@> -mp_primitive(mp, "atleast",at_least,0); -@:at_least_}{\&{atleast} primitive@> -mp_primitive(mp, "begingroup",begin_group,0); mp->bg_loc=mp->cur_sym; -@:begin_group_}{\&{begingroup} primitive@> -mp_primitive(mp, "controls",controls,0); -@:controls_}{\&{controls} primitive@> -mp_primitive(mp, "curl",curl_command,0); -@:curl_}{\&{curl} primitive@> -mp_primitive(mp, "delimiters",delimiters,0); -@:delimiters_}{\&{delimiters} primitive@> -mp_primitive(mp, "endgroup",end_group,0); - mp->eqtb[frozen_end_group]=mp->eqtb[mp->cur_sym]; mp->eg_loc=mp->cur_sym; -@:endgroup_}{\&{endgroup} primitive@> -mp_primitive(mp, "everyjob",every_job_command,0); -@:every_job_}{\&{everyjob} primitive@> -mp_primitive(mp, "exitif",exit_test,0); -@:exit_if_}{\&{exitif} primitive@> -mp_primitive(mp, "expandafter",expand_after,0); -@:expand_after_}{\&{expandafter} primitive@> -mp_primitive(mp, "interim",interim_command,0); -@:interim_}{\&{interim} primitive@> -mp_primitive(mp, "let",let_command,0); -@:let_}{\&{let} primitive@> -mp_primitive(mp, "newinternal",new_internal,0); -@:new_internal_}{\&{newinternal} primitive@> -mp_primitive(mp, "of",of_token,0); -@:of_}{\&{of} primitive@> -mp_primitive(mp, "randomseed",mp_random_seed,0); -@:mp_random_seed_}{\&{randomseed} primitive@> -mp_primitive(mp, "save",save_command,0); -@:save_}{\&{save} primitive@> -mp_primitive(mp, "scantokens",scan_tokens,0); -@:scan_tokens_}{\&{scantokens} primitive@> -mp_primitive(mp, "shipout",ship_out_command,0); -@:ship_out_}{\&{shipout} primitive@> -mp_primitive(mp, "skipto",skip_to,0); -@:skip_to_}{\&{skipto} primitive@> -mp_primitive(mp, "special",special_command,0); -@:special}{\&{special} primitive@> -mp_primitive(mp, "fontmapfile",special_command,1); -@:fontmapfile}{\&{fontmapfile} primitive@> -mp_primitive(mp, "fontmapline",special_command,2); -@:fontmapline}{\&{fontmapline} primitive@> -mp_primitive(mp, "step",step_token,0); -@:step_}{\&{step} primitive@> -mp_primitive(mp, "str",str_op,0); -@:str_}{\&{str} primitive@> -mp_primitive(mp, "tension",tension,0); -@:tension_}{\&{tension} primitive@> -mp_primitive(mp, "to",to_token,0); -@:to_}{\&{to} primitive@> -mp_primitive(mp, "until",until_token,0); -@:until_}{\&{until} primitive@> -mp_primitive(mp, "within",within_token,0); -@:within_}{\&{within} primitive@> -mp_primitive(mp, "write",write_command,0); -@:write_}{\&{write} primitive@> - -@ Each primitive has a corresponding inverse, so that it is possible to -display the cryptic numeric contents of |eqtb| in symbolic form. -Every call of |primitive| in this program is therefore accompanied by some -straightforward code that forms part of the |print_cmd_mod| routine -explained below. - -@<Cases of |print_cmd_mod| for symbolic printing of primitives@>= -case add_to_command:mp_print(mp, "addto"); break; -case assignment:mp_print(mp, ":="); break; -case at_least:mp_print(mp, "atleast"); break; -case bchar_label:mp_print(mp, "||:"); break; -case begin_group:mp_print(mp, "begingroup"); break; -case colon:mp_print(mp, ":"); break; -case comma:mp_print(mp, ","); break; -case controls:mp_print(mp, "controls"); break; -case curl_command:mp_print(mp, "curl"); break; -case delimiters:mp_print(mp, "delimiters"); break; -case double_colon:mp_print(mp, "::"); break; -case end_group:mp_print(mp, "endgroup"); break; -case every_job_command:mp_print(mp, "everyjob"); break; -case exit_test:mp_print(mp, "exitif"); break; -case expand_after:mp_print(mp, "expandafter"); break; -case interim_command:mp_print(mp, "interim"); break; -case left_brace:mp_print(mp, "{"); break; -case left_bracket:mp_print(mp, "["); break; -case let_command:mp_print(mp, "let"); break; -case new_internal:mp_print(mp, "newinternal"); break; -case of_token:mp_print(mp, "of"); break; -case path_join:mp_print(mp, ".."); break; -case mp_random_seed:mp_print(mp, "randomseed"); break; -case relax:mp_print_char(mp, xord('\\')); break; -case right_brace:mp_print_char(mp, xord('}')); break; -case right_bracket:mp_print_char(mp, xord(']')); break; -case save_command:mp_print(mp, "save"); break; -case scan_tokens:mp_print(mp, "scantokens"); break; -case semicolon:mp_print_char(mp, xord(';')); break; -case ship_out_command:mp_print(mp, "shipout"); break; -case skip_to:mp_print(mp, "skipto"); break; -case special_command: if ( m==2 ) mp_print(mp, "fontmapline"); else - if ( m==1 ) mp_print(mp, "fontmapfile"); else - mp_print(mp, "special"); break; -case step_token:mp_print(mp, "step"); break; -case str_op:mp_print(mp, "str"); break; -case tension:mp_print(mp, "tension"); break; -case to_token:mp_print(mp, "to"); break; -case until_token:mp_print(mp, "until"); break; -case within_token:mp_print(mp, "within"); break; -case write_command:mp_print(mp, "write"); break; - -@ We will deal with the other primitives later, at some point in the program -where their |eq_type| and |equiv| values are more meaningful. For example, -the primitives for macro definitions will be loaded when we consider the -routines that define macros. -It is easy to find where each particular -primitive was treated by looking in the index at the end; for example, the -section where |"def"| entered |eqtb| is listed under `\&{def} primitive'. - -@* \[14] Token lists. -A \MP\ token is either symbolic or numeric or a string, or it denotes -a macro parameter or capsule; so there are five corresponding ways to encode it -@^token@> -internally: (1)~A symbolic token whose hash code is~|p| -is represented by the number |p|, in the |info| field of a single-word -node in~|mem|. (2)~A numeric token whose |scaled| value is~|v| is -represented in a two-word node of~|mem|; the |type| field is |known|, -the |name_type| field is |token|, and the |value| field holds~|v|. -The fact that this token appears in a two-word node rather than a -one-word node is, of course, clear from the node address. -(3)~A string token is also represented in a two-word node; the |type| -field is |mp_string_type|, the |name_type| field is |token|, and the -|value| field holds the corresponding |str_number|. (4)~Capsules have -|name_type=capsule|, and their |type| and |value| fields represent -arbitrary values (in ways to be explained later). (5)~Macro parameters -are like symbolic tokens in that they appear in |info| fields of -one-word nodes. The $k$th parameter is represented by |expr_base+k| if it -is of type \&{expr}, or by |suffix_base+k| if it is of type \&{suffix}, or -by |text_base+k| if it is of type \&{text}. (Here |0<=k<param_size|.) -Actual values of these parameters are kept in a separate stack, as we will -see later. The constants |expr_base|, |suffix_base|, and |text_base| are, -of course, chosen so that there will be no confusion between symbolic -tokens and parameters of various types. - -Note that -the `\\{type}' field of a node has nothing to do with ``type'' in a -printer's sense. It's curious that the same word is used in such different ways. - -@d mp_type(A) mp->mem[(A)].hh.b0 /* identifies what kind of value this is */ -@d mp_name_type(A) mp->mem[(A)].hh.b1 /* a clue to the name of this value */ -@d token_node_size 2 /* the number of words in a large token node */ -@d value_loc(A) ((A)+1) /* the word that contains the |value| field */ -@d value(A) mp->mem[value_loc((A))].cint /* the value stored in a large token node */ -@d expr_base (hash_end+1) /* code for the zeroth \&{expr} parameter */ -@d suffix_base (expr_base+mp->param_size) /* code for the zeroth \&{suffix} parameter */ -@d text_base (suffix_base+mp->param_size) /* code for the zeroth \&{text} parameter */ - -@<Check the ``constant''...@>= -if ( text_base+mp->param_size>max_halfword ) mp->bad=18; - -@ We have set aside a two word node beginning at |null| so that we can have -|value(null)=0|. We will make use of this coincidence later. - -@<Initialize table entries...@>= -mp_link(null)=null; value(null)=0; - -@ A numeric token is created by the following trivial routine. - -@c -static pointer mp_new_num_tok (MP mp,scaled v) { - pointer p; /* the new node */ - p=mp_get_node(mp, token_node_size); value(p)=v; - mp_type(p)=mp_known; mp_name_type(p)=mp_token; - return p; -} - -@ A token list is a singly linked list of nodes in |mem|, where -each node contains a token and a link. Here's a subroutine that gets rid -of a token list when it is no longer needed. - -@c static void mp_flush_token_list (MP mp,pointer p) { - pointer q; /* the node being recycled */ - while ( p!=null ) { - q=p; p=mp_link(p); - if ( q>=mp->hi_mem_min ) { - free_avail(q); - } else { - switch (mp_type(q)) { - case mp_vacuous: case mp_boolean_type: case mp_known: - break; - case mp_string_type: - delete_str_ref(value(q)); - break; - case unknown_types: case mp_pen_type: case mp_path_type: - case mp_picture_type: case mp_pair_type: case mp_color_type: - case mp_cmykcolor_type: case mp_transform_type: case mp_dependent: - case mp_proto_dependent: case mp_independent: - mp_recycle_value(mp,q); - break; - default: mp_confusion(mp, "token"); -@:this can't happen token}{\quad token@> - } - mp_free_node(mp, q,token_node_size); - } - } -} - -@ The procedure |show_token_list|, which prints a symbolic form of -the token list that starts at a given node |p|, illustrates these -conventions. The token list being displayed should not begin with a reference -count. However, the procedure is intended to be fairly robust, so that if the -memory links are awry or if |p| is not really a pointer to a token list, -almost nothing catastrophic can happen. - -An additional parameter |q| is also given; this parameter is either null -or it points to a node in the token list where a certain magic computation -takes place that will be explained later. (Basically, |q| is non-null when -we are printing the two-line context information at the time of an error -message; |q| marks the place corresponding to where the second line -should begin.) - -The generation will stop, and `\.{\char`\ ETC.}' will be printed, if the length -of printing exceeds a given limit~|l|; the length of printing upon entry is -assumed to be a given amount called |null_tally|. (Note that -|show_token_list| sometimes uses itself recursively to print -variable names within a capsule.) -@^recursion@> - -Unusual entries are printed in the form of all-caps tokens -preceded by a space, e.g., `\.{\char`\ BAD}'. - -@<Declarations@>= -static void mp_show_token_list (MP mp, integer p, integer q, integer l, - integer null_tally) ; - -@ @c -void mp_show_token_list (MP mp, integer p, integer q, integer l, - integer null_tally) { - quarterword class,c; /* the |char_class| of previous and new tokens */ - integer r,v; /* temporary registers */ - class=percent_class; - mp->tally=null_tally; - while ( (p!=null) && (mp->tally<l) ) { - if ( p==q ) - @<Do magic computation@>; - @<Display token |p| and set |c| to its class; - but |return| if there are problems@>; - class=c; p=mp_link(p); - } - if ( p!=null ) - mp_print(mp, " ETC."); -@.ETC@> - return; -} - -@ @<Display token |p| and set |c| to its class...@>= -c=letter_class; /* the default */ -if ( (p<0)||(p>mp->mem_end) ) { - mp_print(mp, " CLOBBERED"); return; -@.CLOBBERED@> -} -if ( p<mp->hi_mem_min ) { - @<Display two-word token@>; -} else { - r=mp_info(p); - if ( r>=expr_base ) { - @<Display a parameter token@>; - } else { - if ( r<1 ) { - if ( r==0 ) { - @<Display a collective subscript@> - } else { - mp_print(mp, " IMPOSSIBLE"); -@.IMPOSSIBLE@> - } - } else { - r=text(r); - if ( (r<0)||(r>mp->max_str_ptr) ) { - mp_print(mp, " NONEXISTENT"); -@.NONEXISTENT@> - } else { - @<Print string |r| as a symbolic token - and set |c| to its class@>; - } - } - } -} - -@ @<Display two-word token@>= -if ( mp_name_type(p)==mp_token ) { - if ( mp_type(p)==mp_known ) { - @<Display a numeric token@>; - } else if ( mp_type(p)!=mp_string_type ) { - mp_print(mp, " BAD"); -@.BAD@> - } else { - mp_print_char(mp, xord('"')); mp_print_str(mp, value(p)); mp_print_char(mp, xord('"')); - c=string_class; - } -} else if ((mp_name_type(p)!=mp_capsule)||(mp_type(p)<mp_vacuous)||(mp_type(p)>mp_independent) ) { - mp_print(mp, " BAD"); -} else { - mp_print_capsule(mp,p); c=right_paren_class; -} - -@ @<Display a numeric token@>= -if ( class==digit_class ) - mp_print_char(mp, xord(' ')); -v=value(p); -if ( v<0 ){ - if ( class==left_bracket_class ) - mp_print_char(mp, xord(' ')); - mp_print_char(mp, xord('[')); mp_print_scaled(mp, v); mp_print_char(mp, xord(']')); - c=right_bracket_class; -} else { - mp_print_scaled(mp, v); c=digit_class; -} - - -@ Strictly speaking, a genuine token will never have |mp_info(p)=0|. -But we will see later (in the |print_variable_name| routine) that -it is convenient to let |mp_info(p)=0| stand for `\.{[]}'. - -@<Display a collective subscript@>= -{ -if ( class==left_bracket_class ) - mp_print_char(mp, xord(' ')); -mp_print(mp, "[]"); c=right_bracket_class; -} - -@ @<Display a parameter token@>= -{ -if ( r<suffix_base ) { - mp_print(mp, "(EXPR"); r=r-(expr_base); -@.EXPR@> -} else if ( r<text_base ) { - mp_print(mp, "(SUFFIX"); r=r-(suffix_base); -@.SUFFIX@> -} else { - mp_print(mp, "(TEXT"); r=r-(text_base); -@.TEXT@> -} -mp_print_int(mp, r); mp_print_char(mp, xord(')')); c=right_paren_class; -} - - -@ @<Print string |r| as a symbolic token...@>= -{ -c=mp->char_class[mp->str_pool[mp->str_start[r]]]; -if ( c==class ) { - switch (c) { - case letter_class:mp_print_char(mp, xord('.')); break; - case isolated_classes: break; - default: mp_print_char(mp, xord(' ')); break; - } -} -mp_print_str(mp, r); -} - -@ @<Declarations@>= -static void mp_print_capsule (MP mp, pointer p); - -@ @<Declare miscellaneous procedures that were declared |forward|@>= -void mp_print_capsule (MP mp, pointer p) { - mp_print_char(mp, xord('(')); mp_print_exp(mp,p,0); mp_print_char(mp, xord(')')); -} - -@ Macro definitions are kept in \MP's memory in the form of token lists -that have a few extra one-word nodes at the beginning. - -The first node contains a reference count that is used to tell when the -list is no longer needed. To emphasize the fact that a reference count is -present, we shall refer to the |info| field of this special node as the -|ref_count| field. -@^reference counts@> - -The next node or nodes after the reference count serve to describe the -formal parameters. They consist of zero or more parameter tokens followed -by a code for the type of macro. - -@d ref_count mp_info - /* reference count preceding a macro definition or picture header */ -@d add_mac_ref(A) incr(ref_count((A))) /* make a new reference to a macro list */ -@d general_macro 0 /* preface to a macro defined with a parameter list */ -@d primary_macro 1 /* preface to a macro with a \&{primary} parameter */ -@d secondary_macro 2 /* preface to a macro with a \&{secondary} parameter */ -@d tertiary_macro 3 /* preface to a macro with a \&{tertiary} parameter */ -@d expr_macro 4 /* preface to a macro with an undelimited \&{expr} parameter */ -@d of_macro 5 /* preface to a macro with - undelimited `\&{expr} |x| \&{of}~|y|' parameters */ -@d suffix_macro 6 /* preface to a macro with an undelimited \&{suffix} parameter */ -@d text_macro 7 /* preface to a macro with an undelimited \&{text} parameter */ - -@c -static void mp_delete_mac_ref (MP mp,pointer p) { - /* |p| points to the reference count of a macro list that is - losing one reference */ - if ( ref_count(p)==null ) mp_flush_token_list(mp, p); - else decr(ref_count(p)); -} - -@ The following subroutine displays a macro, given a pointer to its -reference count. - -@c -static void mp_show_macro (MP mp, pointer p, integer q, integer l) { - pointer r; /* temporary storage */ - p=mp_link(p); /* bypass the reference count */ - while ( mp_info(p)>text_macro ){ - r=mp_link(p); mp_link(p)=null; - mp_show_token_list(mp, p,null,l,0); mp_link(p)=r; p=r; - if ( l>0 ) l=l-mp->tally; else return; - } /* control printing of `\.{ETC.}' */ -@.ETC@> - mp->tally=0; - switch(mp_info(p)) { - case general_macro:mp_print(mp, "->"); break; -@.->@> - case primary_macro: case secondary_macro: case tertiary_macro: - mp_print_char(mp, xord('<')); - mp_print_cmd_mod(mp, param_type,mp_info(p)); - mp_print(mp, ">->"); - break; - case expr_macro:mp_print(mp, "<expr>->"); break; - case of_macro:mp_print(mp, "<expr>of<primary>->"); break; - case suffix_macro:mp_print(mp, "<suffix>->"); break; - case text_macro:mp_print(mp, "<text>->"); break; - } /* there are no other cases */ - mp_show_token_list(mp, mp_link(p),q,l-mp->tally,0); -} - -@* \[15] Data structures for variables. -The variables of \MP\ programs can be simple, like `\.x', or they can -combine the structural properties of arrays and records, like `\.{x20a.b}'. -A \MP\ user assigns a type to a variable like \.{x20a.b} by saying, for -example, `\.{boolean} \.{x[]a.b}'. It's time for us to study how such -things are represented inside of the computer. - -Each variable value occupies two consecutive words, either in a two-word -node called a value node, or as a two-word subfield of a larger node. One -of those two words is called the |value| field; it is an integer, -containing either a |scaled| numeric value or the representation of some -other type of quantity. (It might also be subdivided into halfwords, in -which case it is referred to by other names instead of |value|.) The other -word is broken into subfields called |type|, |name_type|, and |link|. The -|type| field is a quarterword that specifies the variable's type, and -|name_type| is a quarterword from which \MP\ can reconstruct the -variable's name (sometimes by using the |link| field as well). Thus, only -1.25 words are actually devoted to the value itself; the other -three-quarters of a word are overhead, but they aren't wasted because they -allow \MP\ to deal with sparse arrays and to provide meaningful diagnostics. - -In this section we shall be concerned only with the structural aspects of -variables, not their values. Later parts of the program will change the -|type| and |value| fields, but we shall treat those fields as black boxes -whose contents should not be touched. - -However, if the |type| field is |mp_structured|, there is no |value| field, -and the second word is broken into two pointer fields called |attr_head| -and |subscr_head|. Those fields point to additional nodes that -contain structural information, as we shall see. - -@d subscr_head_loc(A) (A)+1 /* where |value|, |subscr_head| and |attr_head| are */ -@d attr_head(A) mp_info(subscr_head_loc((A))) /* pointer to attribute info */ -@d subscr_head(A) mp_link(subscr_head_loc((A))) /* pointer to subscript info */ -@d value_node_size 2 /* the number of words in a value node */ - -@ An attribute node is three words long. Two of these words contain |type| -and |value| fields as described above, and the third word contains -additional information: There is an |attr_loc| field, which contains the -hash address of the token that names this attribute; and there's also a -|parent| field, which points to the value node of |mp_structured| type at the -next higher level (i.e., at the level to which this attribute is -subsidiary). The |name_type| in an attribute node is `|attr|'. The -|link| field points to the next attribute with the same parent; these are -arranged in increasing order, so that |attr_loc(mp_link(p))>attr_loc(p)|. The -final attribute node links to the constant |end_attr|, whose |attr_loc| -field is greater than any legal hash address. The |attr_head| in the -parent points to a node whose |name_type| is |mp_structured_root|; this -node represents the null attribute, i.e., the variable that is relevant -when no attributes are attached to the parent. The |attr_head| node -has the fields of either -a value node, a subscript node, or an attribute node, depending on what -the parent would be if it were not structured; but the subscript and -attribute fields are ignored, so it effectively contains only the data of -a value node. The |link| field in this special node points to an attribute -node whose |attr_loc| field is zero; the latter node represents a collective -subscript `\.{[]}' attached to the parent, and its |link| field points to -the first non-special attribute node (or to |end_attr| if there are none). - -A subscript node likewise occupies three words, with |type| and |value| fields -plus extra information; its |name_type| is |subscr|. In this case the -third word is called the |subscript| field, which is a |scaled| integer. -The |link| field points to the subscript node with the next larger -subscript, if any; otherwise the |link| points to the attribute node -for collective subscripts at this level. We have seen that the latter node -contains an upward pointer, so that the parent can be deduced. - -The |name_type| in a parent-less value node is |root|, and the |link| -is the hash address of the token that names this value. - -In other words, variables have a hierarchical structure that includes -enough threads running around so that the program is able to move easily -between siblings, parents, and children. An example should be helpful: -(The reader is advised to draw a picture while reading the following -description, since that will help to firm up the ideas.) -Suppose that `\.x' and `\.{x.a}' and `\.{x[]b}' and `\.{x5}' -and `\.{x20b}' have been mentioned in a user's program, where -\.{x[]b} has been declared to be of \&{boolean} type. Let |h(x)|, |h(a)|, -and |h(b)| be the hash addresses of \.x, \.a, and~\.b. Then -|eq_type(h(x))=name| and |equiv(h(x))=p|, where |p|~is a two-word value -node with |mp_name_type(p)=root| and |mp_link(p)=h(x)|. We have |type(p)=mp_structured|, -|attr_head(p)=q|, and |subscr_head(p)=r|, where |q| points to a value -node and |r| to a subscript node. (Are you still following this? Use -a pencil to draw a diagram.) The lone variable `\.x' is represented by -|type(q)| and |value(q)|; furthermore -|mp_name_type(q)=mp_structured_root| and |mp_link(q)=q1|, where |q1| points -to an attribute node representing `\.{x[]}'. Thus |mp_name_type(q1)=attr|, -|attr_loc(q1)=collective_subscript=0|, |parent(q1)=p|, -|type(q1)=mp_structured|, |attr_head(q1)=qq|, and |subscr_head(q1)=qq1|; -|qq| is a three-word ``attribute-as-value'' node with |type(qq)=numeric_type| -(assuming that \.{x5} is numeric, because |qq| represents `\.{x[]}' -with no further attributes), |mp_name_type(qq)=structured_root|, -|attr_loc(qq)=0|, |parent(qq)=p|, and -|mp_link(qq)=qq1|. (Now pay attention to the next part.) Node |qq1| is -an attribute node representing `\.{x[][]}', which has never yet -occurred; its |type| field is |undefined|, and its |value| field is -undefined. We have |mp_name_type(qq1)=attr|, |attr_loc(qq1)=collective_subscript|, -|parent(qq1)=q1|, and |mp_link(qq1)=qq2|. Since |qq2| represents -`\.{x[]b}', |type(qq2)=mp_unknown_boolean|; also |attr_loc(qq2)=h(b)|, -|parent(qq2)=q1|, |mp_name_type(qq2)=attr|, |mp_link(qq2)=end_attr|. -(Maybe colored lines will help untangle your picture.) - Node |r| is a subscript node with |type| and |value| -representing `\.{x5}'; |mp_name_type(r)=subscr|, |subscript(r)=5.0|, -and |mp_link(r)=r1| is another subscript node. To complete the picture, -see if you can guess what |mp_link(r1)| is; give up? It's~|q1|. -Furthermore |subscript(r1)=20.0|, |mp_name_type(r1)=subscr|, -|type(r1)=mp_structured|, |attr_head(r1)=qqq|, |subscr_head(r1)=qqq1|, -and we finish things off with three more nodes -|qqq|, |qqq1|, and |qqq2| hung onto~|r1|. (Perhaps you should start again -with a larger sheet of paper.) The value of variable \.{x20b} -appears in node~|qqq2|, as you can well imagine. - -If the example in the previous paragraph doesn't make things crystal -clear, a glance at some of the simpler subroutines below will reveal how -things work out in practice. - -The only really unusual thing about these conventions is the use of -collective subscript attributes. The idea is to avoid repeating a lot of -type information when many elements of an array are identical macros -(for which distinct values need not be stored) or when they don't have -all of the possible attributes. Branches of the structure below collective -subscript attributes do not carry actual values except for macro identifiers; -branches of the structure below subscript nodes do not carry significant -information in their collective subscript attributes. - -@d attr_loc_loc(A) ((A)+2) /* where the |attr_loc| and |parent| fields are */ -@d attr_loc(A) mp_info(attr_loc_loc((A))) /* hash address of this attribute */ -@d parent(A) mp_link(attr_loc_loc((A))) /* pointer to |mp_structured| variable */ -@d subscript_loc(A) ((A)+2) /* where the |subscript| field lives */ -@d subscript(A) mp->mem[subscript_loc((A))].sc /* subscript of this variable */ -@d attr_node_size 3 /* the number of words in an attribute node */ -@d subscr_node_size 3 /* the number of words in a subscript node */ -@d collective_subscript 0 /* code for the attribute `\.{[]}' */ - -@<Initialize table...@>= -attr_loc(end_attr)=hash_end+1; parent(end_attr)=null; - -@ Variables of type \&{pair} will have values that point to four-word -nodes containing two numeric values. The first of these values has -|name_type=mp_x_part_sector| and the second has |name_type=mp_y_part_sector|; -the |link| in the first points back to the node whose |value| points -to this four-word node. - -Variables of type \&{transform} are similar, but in this case their -|value| points to a 12-word node containing six values, identified by -|x_part_sector|, |y_part_sector|, |mp_xx_part_sector|, |mp_xy_part_sector|, -|mp_yx_part_sector|, and |mp_yy_part_sector|. -Finally, variables of type \&{color} have 3~values in 6~words -identified by |mp_red_part_sector|, |mp_green_part_sector|, and |mp_blue_part_sector|. - -When an entire structured variable is saved, the |root| indication -is temporarily replaced by |saved_root|. - -Some variables have no name; they just are used for temporary storage -while expressions are being evaluated. We call them {\sl capsules}. - -@d x_part_loc(A) (A) /* where the \&{xpart} is found in a pair or transform node */ -@d y_part_loc(A) ((A)+2) /* where the \&{ypart} is found in a pair or transform node */ -@d xx_part_loc(A) ((A)+4) /* where the \&{xxpart} is found in a transform node */ -@d xy_part_loc(A) ((A)+6) /* where the \&{xypart} is found in a transform node */ -@d yx_part_loc(A) ((A)+8) /* where the \&{yxpart} is found in a transform node */ -@d yy_part_loc(A) ((A)+10) /* where the \&{yypart} is found in a transform node */ -@d red_part_loc(A) (A) /* where the \&{redpart} is found in a color node */ -@d green_part_loc(A) ((A)+2) /* where the \&{greenpart} is found in a color node */ -@d blue_part_loc(A) ((A)+4) /* where the \&{bluepart} is found in a color node */ -@d cyan_part_loc(A) (A) /* where the \&{cyanpart} is found in a color node */ -@d magenta_part_loc(A) ((A)+2) /* where the \&{magentapart} is found in a color node */ -@d yellow_part_loc(A) ((A)+4) /* where the \&{yellowpart} is found in a color node */ -@d black_part_loc(A) ((A)+6) /* where the \&{blackpart} is found in a color node */ -@d grey_part_loc(A) (A) /* where the \&{greypart} is found in a color node */ -@# -@d pair_node_size 4 /* the number of words in a pair node */ -@d transform_node_size 12 /* the number of words in a transform node */ -@d color_node_size 6 /* the number of words in a color node */ -@d cmykcolor_node_size 8 /* the number of words in a color node */ - -@<Glob...@>= -quarterword big_node_size[mp_pair_type+1]; -quarterword sector0[mp_pair_type+1]; -quarterword sector_offset[mp_black_part_sector+1]; - -@ The |sector0| array gives for each big node type, |name_type| values -for its first subfield; the |sector_offset| array gives for each -|name_type| value, the offset from the first subfield in words; -and the |big_node_size| array gives the size in words for each type of -big node. - -@<Set init...@>= -mp->big_node_size[mp_transform_type]=transform_node_size; -mp->big_node_size[mp_pair_type]=pair_node_size; -mp->big_node_size[mp_color_type]=color_node_size; -mp->big_node_size[mp_cmykcolor_type]=cmykcolor_node_size; -mp->sector0[mp_transform_type]=mp_x_part_sector; -mp->sector0[mp_pair_type]=mp_x_part_sector; -mp->sector0[mp_color_type]=mp_red_part_sector; -mp->sector0[mp_cmykcolor_type]=mp_cyan_part_sector; -for (k=mp_x_part_sector;k<= mp_yy_part_sector;k++ ) { - mp->sector_offset[k]=2*(k-mp_x_part_sector); -} -for (k=mp_red_part_sector;k<= mp_blue_part_sector ; k++) { - mp->sector_offset[k]=2*(k-mp_red_part_sector); -} -for (k=mp_cyan_part_sector;k<= mp_black_part_sector;k++ ) { - mp->sector_offset[k]=2*(k-mp_cyan_part_sector); -} - -@ If |type(p)=mp_pair_type| or |mp_transform_type| and if |value(p)=null|, the -procedure call |init_big_node(p)| will allocate a pair or transform node -for~|p|. The individual parts of such nodes are initially of type -|mp_independent|. - -@c -static void mp_init_big_node (MP mp,pointer p) { - pointer q; /* the new node */ - quarterword s; /* its size */ - s=mp->big_node_size[mp_type(p)]; q=mp_get_node(mp, s); - do { - s=s-2; - @<Make variable |q+s| newly independent@>; - mp_name_type(q+s)=halfp(s)+mp->sector0[mp_type(p)]; - mp_link(q+s)=null; - } while (s!=0); - mp_link(q)=p; value(p)=q; -} - -@ The |id_transform| function creates a capsule for the -identity transformation. - -@c -static pointer mp_id_transform (MP mp) { - pointer p,q,r; /* list manipulation registers */ - p=mp_get_node(mp, value_node_size); mp_type(p)=mp_transform_type; - mp_name_type(p)=mp_capsule; value(p)=null; mp_init_big_node(mp, p); q=value(p); - r=q+transform_node_size; - do { - r=r-2; - mp_type(r)=mp_known; value(r)=0; - } while (r!=q); - value(xx_part_loc(q))=unity; - value(yy_part_loc(q))=unity; - return p; -} - -@ Tokens are of type |tag_token| when they first appear, but they point -to |null| until they are first used as the root of a variable. -The following subroutine establishes the root node on such grand occasions. - -@c -static void mp_new_root (MP mp,pointer x) { - pointer p; /* the new node */ - p=mp_get_node(mp, value_node_size); mp_type(p)=undefined; mp_name_type(p)=mp_root; - mp_link(p)=x; equiv(x)=p; -} - -@ These conventions for variable representation are illustrated by the -|print_variable_name| routine, which displays the full name of a -variable given only a pointer to its two-word value packet. - -@<Declarations@>= -static void mp_print_variable_name (MP mp, pointer p); - -@ @c -void mp_print_variable_name (MP mp, pointer p) { - pointer q; /* a token list that will name the variable's suffix */ - pointer r; /* temporary for token list creation */ - while ( mp_name_type(p)>=mp_x_part_sector ) { - @<Preface the output with a part specifier; |return| in the - case of a capsule@>; - } - q=null; - while ( mp_name_type(p)>mp_saved_root ) { - @<Ascend one level, pushing a token onto list |q| - and replacing |p| by its parent@>; - } - r=mp_get_avail(mp); mp_info(r)=mp_link(p); mp_link(r)=q; - if ( mp_name_type(p)==mp_saved_root ) mp_print(mp, "(SAVED)"); -@.SAVED@> - mp_show_token_list(mp, r,null,el_gordo,mp->tally); - mp_flush_token_list(mp, r); -} - -@ @<Ascend one level, pushing a token onto list |q|...@>= -{ - if ( mp_name_type(p)==mp_subscr ) { - r=mp_new_num_tok(mp, subscript(p)); - do { - p=mp_link(p); - } while (mp_name_type(p)!=mp_attr); - } else if ( mp_name_type(p)==mp_structured_root ) { - p=mp_link(p); goto FOUND; - } else { - if ( mp_name_type(p)!=mp_attr ) mp_confusion(mp, "var"); -@:this can't happen var}{\quad var@> - r=mp_get_avail(mp); mp_info(r)=attr_loc(p); - } - mp_link(r)=q; q=r; -FOUND: - p=parent(p); -} - -@ @<Preface the output with a part specifier...@>= -{ switch (mp_name_type(p)) { - case mp_x_part_sector: mp_print_char(mp, xord('x')); break; - case mp_y_part_sector: mp_print_char(mp, xord('y')); break; - case mp_xx_part_sector: mp_print(mp, "xx"); break; - case mp_xy_part_sector: mp_print(mp, "xy"); break; - case mp_yx_part_sector: mp_print(mp, "yx"); break; - case mp_yy_part_sector: mp_print(mp, "yy"); break; - case mp_red_part_sector: mp_print(mp, "red"); break; - case mp_green_part_sector: mp_print(mp, "green"); break; - case mp_blue_part_sector: mp_print(mp, "blue"); break; - case mp_cyan_part_sector: mp_print(mp, "cyan"); break; - case mp_magenta_part_sector: mp_print(mp, "magenta"); break; - case mp_yellow_part_sector: mp_print(mp, "yellow"); break; - case mp_black_part_sector: mp_print(mp, "black"); break; - case mp_grey_part_sector: mp_print(mp, "grey"); break; - case mp_capsule: - mp_print(mp, "%CAPSULE"); mp_print_int(mp, p-null); return; - break; -@.CAPSULE@> - } /* there are no other cases */ - mp_print(mp, "part "); - p=mp_link(p-mp->sector_offset[mp_name_type(p)]); -} - -@ The |interesting| function returns |true| if a given variable is not -in a capsule, or if the user wants to trace capsules. - -@c -static boolean mp_interesting (MP mp,pointer p) { - quarterword t; /* a |name_type| */ - if ( mp->internal[mp_tracing_capsules]>0 ) { - return true; - } else { - t=mp_name_type(p); - if ( t>=mp_x_part_sector ) if ( t!=mp_capsule ) - t=mp_name_type(mp_link(p-mp->sector_offset[t])); - return (t!=mp_capsule); - } -} - -@ Now here is a subroutine that converts an unstructured type into an -equivalent structured type, by inserting a |mp_structured| node that is -capable of growing. This operation is done only when |mp_name_type(p)=root|, -|subscr|, or |attr|. - -The procedure returns a pointer to the new node that has taken node~|p|'s -place in the structure. Node~|p| itself does not move, nor are its -|value| or |type| fields changed in any way. - -@c -static pointer mp_new_structure (MP mp,pointer p) { - pointer q,r=0; /* list manipulation registers */ - switch (mp_name_type(p)) { - case mp_root: - q=mp_link(p); r=mp_get_node(mp, value_node_size); equiv(q)=r; - break; - case mp_subscr: - @<Link a new subscript node |r| in place of node |p|@>; - break; - case mp_attr: - @<Link a new attribute node |r| in place of node |p|@>; - break; - default: - mp_confusion(mp, "struct"); -@:this can't happen struct}{\quad struct@> - break; - } - mp_link(r)=mp_link(p); mp_type(r)=mp_structured; mp_name_type(r)=mp_name_type(p); - attr_head(r)=p; mp_name_type(p)=mp_structured_root; - q=mp_get_node(mp, attr_node_size); mp_link(p)=q; subscr_head(r)=q; - parent(q)=r; mp_type(q)=undefined; mp_name_type(q)=mp_attr; mp_link(q)=end_attr; - attr_loc(q)=collective_subscript; - return r; -} - -@ @<Link a new subscript node |r| in place of node |p|@>= -{ - q=p; - do { - q=mp_link(q); - } while (mp_name_type(q)!=mp_attr); - q=parent(q); r=subscr_head_loc(q); /* |mp_link(r)=subscr_head(q)| */ - do { - q=r; r=mp_link(r); - } while (r!=p); - r=mp_get_node(mp, subscr_node_size); - mp_link(q)=r; subscript(r)=subscript(p); -} - -@ If the attribute is |collective_subscript|, there are two pointers to -node~|p|, so we must change both of them. - -@<Link a new attribute node |r| in place of node |p|@>= -{ - q=parent(p); r=attr_head(q); - do { - q=r; r=mp_link(r); - } while (r!=p); - r=mp_get_node(mp, attr_node_size); mp_link(q)=r; - mp->mem[attr_loc_loc(r)]=mp->mem[attr_loc_loc(p)]; /* copy |attr_loc| and |parent| */ - if ( attr_loc(p)==collective_subscript ) { - q=subscr_head_loc(parent(p)); - while ( mp_link(q)!=p ) q=mp_link(q); - mp_link(q)=r; - } -} - -@ The |find_variable| routine is given a pointer~|t| to a nonempty token -list of suffixes; it returns a pointer to the corresponding two-word -value. For example, if |t| points to token \.x followed by a numeric -token containing the value~7, |find_variable| finds where the value of -\.{x7} is stored in memory. This may seem a simple task, and it -usually is, except when \.{x7} has never been referenced before. -Indeed, \.x may never have even been subscripted before; complexities -arise with respect to updating the collective subscript information. - -If a macro type is detected anywhere along path~|t|, or if the first -item on |t| isn't a |tag_token|, the value |null| is returned. -Otherwise |p| will be a non-null pointer to a node such that -|undefined<type(p)<mp_structured|. - -@d abort_find { return null; } - -@c -static pointer mp_find_variable (MP mp,pointer t) { - pointer p,q,r,s; /* nodes in the ``value'' line */ - pointer pp,qq,rr,ss; /* nodes in the ``collective'' line */ - integer n; /* subscript or attribute */ - memory_word save_word; /* temporary storage for a word of |mem| */ -@^inner loop@> - p=mp_info(t); t=mp_link(t); - if ( (eq_type(p) % outer_tag) != tag_token ) abort_find; - if ( equiv(p)==null ) mp_new_root(mp, p); - p=equiv(p); pp=p; - while ( t!=null ) { - @<Make sure that both nodes |p| and |pp| are of |mp_structured| type@>; - if ( t<mp->hi_mem_min ) { - @<Descend one level for the subscript |value(t)|@> - } else { - @<Descend one level for the attribute |mp_info(t)|@>; - } - t=mp_link(t); - } - if ( mp_type(pp)>=mp_structured ) { - if ( mp_type(pp)==mp_structured ) pp=attr_head(pp); else abort_find; - } - if ( mp_type(p)==mp_structured ) p=attr_head(p); - if ( mp_type(p)==undefined ) { - if ( mp_type(pp)==undefined ) { mp_type(pp)=mp_numeric_type; value(pp)=null; }; - mp_type(p)=mp_type(pp); value(p)=null; - }; - return p; -} - -@ Although |pp| and |p| begin together, they diverge when a subscript occurs; -|pp|~stays in the collective line while |p|~goes through actual subscript -values. - -@<Make sure that both nodes |p| and |pp|...@>= -if ( mp_type(pp)!=mp_structured ) { - if ( mp_type(pp)>mp_structured ) abort_find; - ss=mp_new_structure(mp, pp); - if ( p==pp ) p=ss; - pp=ss; -}; /* now |type(pp)=mp_structured| */ -if ( mp_type(p)!=mp_structured ) /* it cannot be |>mp_structured| */ - p=mp_new_structure(mp, p) /* now |type(p)=mp_structured| */ - -@ We want this part of the program to be reasonably fast, in case there are -@^inner loop@> -lots of subscripts at the same level of the data structure. Therefore -we store an ``infinite'' value in the word that appears at the end of the -subscript list, even though that word isn't part of a subscript node. - -@<Descend one level for the subscript |value(t)|@>= -{ - n=value(t); - pp=mp_link(attr_head(pp)); /* now |attr_loc(pp)=collective_subscript| */ - q=mp_link(attr_head(p)); save_word=mp->mem[subscript_loc(q)]; - subscript(q)=el_gordo; s=subscr_head_loc(p); /* |mp_link(s)=subscr_head(p)| */ - do { - r=s; s=mp_link(s); - } while (n>subscript(s)); - if ( n==subscript(s) ) { - p=s; - } else { - p=mp_get_node(mp, subscr_node_size); mp_link(r)=p; mp_link(p)=s; - subscript(p)=n; mp_name_type(p)=mp_subscr; mp_type(p)=undefined; - } - mp->mem[subscript_loc(q)]=save_word; -} - -@ @<Descend one level for the attribute |mp_info(t)|@>= -{ - n=mp_info(t); - ss=attr_head(pp); - do { - rr=ss; ss=mp_link(ss); - } while (n>attr_loc(ss)); - if ( n<attr_loc(ss) ) { - qq=mp_get_node(mp, attr_node_size); mp_link(rr)=qq; mp_link(qq)=ss; - attr_loc(qq)=n; mp_name_type(qq)=mp_attr; mp_type(qq)=undefined; - parent(qq)=pp; ss=qq; - } - if ( p==pp ) { - p=ss; pp=ss; - } else { - pp=ss; s=attr_head(p); - do { - r=s; s=mp_link(s); - } while (n>attr_loc(s)); - if ( n==attr_loc(s) ) { - p=s; - } else { - q=mp_get_node(mp, attr_node_size); mp_link(r)=q; mp_link(q)=s; - attr_loc(q)=n; mp_name_type(q)=mp_attr; mp_type(q)=undefined; - parent(q)=p; p=q; - } - } -} - -@ Variables lose their former values when they appear in a type declaration, -or when they are defined to be macros or \&{let} equal to something else. -A subroutine will be defined later that recycles the storage associated -with any particular |type| or |value|; our goal now is to study a higher -level process called |flush_variable|, which selectively frees parts of a -variable structure. - -This routine has some complexity because of examples such as -`\hbox{\tt numeric x[]a[]b}' -which recycles all variables of the form \.{x[i]a[j]b} (and no others), while -`\hbox{\tt vardef x[]a[]=...}' -discards all variables of the form \.{x[i]a[j]} followed by an arbitrary -suffix, except for the collective node \.{x[]a[]} itself. The obvious way -to handle such examples is to use recursion; so that's what we~do. -@^recursion@> - -Parameter |p| points to the root information of the variable; -parameter |t| points to a list of one-word nodes that represent -suffixes, with |info=collective_subscript| for subscripts. - -@<Declarations@>= -static void mp_flush_cur_exp (MP mp,scaled v) ; - -@ @c -static void mp_flush_variable (MP mp,pointer p, pointer t, boolean discard_suffixes) { - pointer q,r; /* list manipulation */ - halfword n; /* attribute to match */ - while ( t!=null ) { - if ( mp_type(p)!=mp_structured ) return; - n=mp_info(t); t=mp_link(t); - if ( n==collective_subscript ) { - r=subscr_head_loc(p); q=mp_link(r); /* |q=subscr_head(p)| */ - while ( mp_name_type(q)==mp_subscr ){ - mp_flush_variable(mp, q,t,discard_suffixes); - if ( t==null ) { - if ( mp_type(q)==mp_structured ) r=q; - else { mp_link(r)=mp_link(q); mp_free_node(mp, q,subscr_node_size); } - } else { - r=q; - } - q=mp_link(r); - } - } - p=attr_head(p); - do { - r=p; p=mp_link(p); - } while (attr_loc(p)<n); - if ( attr_loc(p)!=n ) return; - } - if ( discard_suffixes ) { - mp_flush_below_variable(mp, p); - } else { - if ( mp_type(p)==mp_structured ) p=attr_head(p); - mp_recycle_value(mp, p); - } -} - -@ The next procedure is simpler; it wipes out everything but |p| itself, -which becomes undefined. - -@<Declarations@>= -static void mp_flush_below_variable (MP mp, pointer p); - -@ @c -void mp_flush_below_variable (MP mp,pointer p) { - pointer q,r; /* list manipulation registers */ - if ( mp_type(p)!=mp_structured ) { - mp_recycle_value(mp, p); /* this sets |type(p)=undefined| */ - } else { - q=subscr_head(p); - while ( mp_name_type(q)==mp_subscr ) { - mp_flush_below_variable(mp, q); r=q; q=mp_link(q); - mp_free_node(mp, r,subscr_node_size); - } - r=attr_head(p); q=mp_link(r); mp_recycle_value(mp, r); - if ( mp_name_type(p)<=mp_saved_root ) mp_free_node(mp, r,value_node_size); - else mp_free_node(mp, r,subscr_node_size); - /* we assume that |subscr_node_size=attr_node_size| */ - do { - mp_flush_below_variable(mp, q); r=q; q=mp_link(q); mp_free_node(mp, r,attr_node_size); - } while (q!=end_attr); - mp_type(p)=undefined; - } -} - -@ Just before assigning a new value to a variable, we will recycle the -old value and make the old value undefined. The |und_type| routine -determines what type of undefined value should be given, based on -the current type before recycling. - -@c -static quarterword mp_und_type (MP mp,pointer p) { - switch (mp_type(p)) { - case undefined: case mp_vacuous: - return undefined; - case mp_boolean_type: case mp_unknown_boolean: - return mp_unknown_boolean; - case mp_string_type: case mp_unknown_string: - return mp_unknown_string; - case mp_pen_type: case mp_unknown_pen: - return mp_unknown_pen; - case mp_path_type: case mp_unknown_path: - return mp_unknown_path; - case mp_picture_type: case mp_unknown_picture: - return mp_unknown_picture; - case mp_transform_type: case mp_color_type: case mp_cmykcolor_type: - case mp_pair_type: case mp_numeric_type: - return mp_type(p); - case mp_known: case mp_dependent: case mp_proto_dependent: case mp_independent: - return mp_numeric_type; - } /* there are no other cases */ - return 0; -} - -@ The |clear_symbol| routine is used when we want to redefine the equivalent -of a symbolic token. It must remove any variable structure or macro -definition that is currently attached to that symbol. If the |saving| -parameter is true, a subsidiary structure is saved instead of destroyed. - -@c -static void mp_clear_symbol (MP mp,pointer p, boolean saving) { - pointer q; /* |equiv(p)| */ - q=equiv(p); - switch (eq_type(p) % outer_tag) { - case defined_macro: - case secondary_primary_macro: - case tertiary_secondary_macro: - case expression_tertiary_macro: - if ( ! saving ) mp_delete_mac_ref(mp, q); - break; - case tag_token: - if ( q!=null ) { - if ( saving ) { - mp_name_type(q)=mp_saved_root; - } else { - mp_flush_below_variable(mp, q); - mp_free_node(mp,q,value_node_size); - } - } - break; - default: - break; - } - mp->eqtb[p]=mp->eqtb[frozen_undefined]; -} - -@* \[16] Saving and restoring equivalents. -The nested structure given by \&{begingroup} and \&{endgroup} -allows |eqtb| entries to be saved and restored, so that temporary changes -can be made without difficulty. When the user requests a current value to -be saved, \MP\ puts that value into its ``save stack.'' An appearance of -\&{endgroup} ultimately causes the old values to be removed from the save -stack and put back in their former places. - -The save stack is a linked list containing three kinds of entries, -distinguished by their |info| fields. If |p| points to a saved item, -then - -\smallskip\hang -|mp_info(p)=0| stands for a group boundary; each \&{begingroup} contributes -such an item to the save stack and each \&{endgroup} cuts back the stack -until the most recent such entry has been removed. - -\smallskip\hang -|mp_info(p)=q|, where |1<=q<=hash_end|, means that |mem[p+1]| holds the former -contents of |eqtb[q]|. Such save stack entries are generated by \&{save} -commands. - -\smallskip\hang -|mp_info(p)=hash_end+q|, where |q>0|, means that |value(p)| is a |scaled| -integer to be restored to internal parameter number~|q|. Such entries -are generated by \&{interim} commands. - -\smallskip\noindent -The global variable |save_ptr| points to the top item on the save stack. - -@d save_node_size 2 /* number of words per non-boundary save-stack node */ -@d saved_equiv(A) mp->mem[(A)+1].hh /* where an |eqtb| entry gets saved */ -@d save_boundary_item(A) { (A)=mp_get_avail(mp); mp_info((A))=0; - mp_link((A))=mp->save_ptr; mp->save_ptr=(A); - } - -@<Glob...@>= -pointer save_ptr; /* the most recently saved item */ - -@ @<Set init...@>=mp->save_ptr=null; - -@ The |save_variable| routine is given a hash address |q|; it salts this -address in the save stack, together with its current equivalent, -then makes token~|q| behave as though it were brand new. - -Nothing is stacked when |save_ptr=null|, however; there's no way to remove -things from the stack when the program is not inside a group, so there's -no point in wasting the space. - -@c -static void mp_save_variable (MP mp,pointer q) { - pointer p; /* temporary register */ - if ( mp->save_ptr!=null ){ - p=mp_get_node(mp, save_node_size); mp_info(p)=q; mp_link(p)=mp->save_ptr; - saved_equiv(p)=mp->eqtb[q]; mp->save_ptr=p; - } - mp_clear_symbol(mp, q,(mp->save_ptr!=null)); -} - -@ Similarly, |save_internal| is given the location |q| of an internal -quantity like |mp_tracing_pens|. It creates a save stack entry of the -third kind. - -@c -static void mp_save_internal (MP mp,halfword q) { - pointer p; /* new item for the save stack */ - if ( mp->save_ptr!=null ){ - p=mp_get_node(mp, save_node_size); mp_info(p)=hash_end+q; - mp_link(p)=mp->save_ptr; value(p)=mp->internal[q]; mp->save_ptr=p; - } -} - -@ At the end of a group, the |unsave| routine restores all of the saved -equivalents in reverse order. This routine will be called only when there -is at least one boundary item on the save stack. - -@c -static void mp_unsave (MP mp) { - pointer q; /* index to saved item */ - pointer p; /* temporary register */ - while ( mp_info(mp->save_ptr)!=0 ) { - q=mp_info(mp->save_ptr); - if ( q>hash_end ) { - if ( mp->internal[mp_tracing_restores]>0 ) { - mp_begin_diagnostic(mp); mp_print_nl(mp, "{restoring "); - mp_print(mp, mp->int_name[q-(hash_end)]); mp_print_char(mp, xord('=')); - mp_print_scaled(mp, value(mp->save_ptr)); mp_print_char(mp, xord('}')); - mp_end_diagnostic(mp, false); - } - mp->internal[q-(hash_end)]=value(mp->save_ptr); - } else { - if ( mp->internal[mp_tracing_restores]>0 ) { - mp_begin_diagnostic(mp); mp_print_nl(mp, "{restoring "); - mp_print_text(q); mp_print_char(mp, xord('}')); - mp_end_diagnostic(mp, false); - } - mp_clear_symbol(mp, q,false); - mp->eqtb[q]=saved_equiv(mp->save_ptr); - if ( eq_type(q) % outer_tag==tag_token ) { - p=equiv(q); - if ( p!=null ) mp_name_type(p)=mp_root; - } - } - p=mp_link(mp->save_ptr); - mp_free_node(mp, mp->save_ptr,save_node_size); mp->save_ptr=p; - } - p=mp_link(mp->save_ptr); free_avail(mp->save_ptr); mp->save_ptr=p; -} - -@* \[17] Data structures for paths. -When a \MP\ user specifies a path, \MP\ will create a list of knots -and control points for the associated cubic spline curves. If the -knots are $z_0$, $z_1$, \dots, $z_n$, there are control points -$z_k^+$ and $z_{k+1}^-$ such that the cubic splines between knots -$z_k$ and $z_{k+1}$ are defined by B\'ezier's formula -@:Bezier}{B\'ezier, Pierre Etienne@> -$$\eqalign{z(t)&=B(z_k,z_k^+,z_{k+1}^-,z_{k+1};t)\cr -&=(1-t)^3z_k+3(1-t)^2tz_k^++3(1-t)t^2z_{k+1}^-+t^3z_{k+1}\cr}$$ -for |0<=t<=1|. - -There is a 8-word node for each knot $z_k$, containing one word of -control information and six words for the |x| and |y| coordinates of -$z_k^-$ and $z_k$ and~$z_k^+$. The control information appears in the -|mp_left_type| and |mp_right_type| fields, which each occupy a quarter of -the first word in the node; they specify properties of the curve as it -enters and leaves the knot. There's also a halfword |link| field, -which points to the following knot, and a final supplementary word (of -which only a quarter is used). - -If the path is a closed contour, knots 0 and |n| are identical; -i.e., the |link| in knot |n-1| points to knot~0. But if the path -is not closed, the |mp_left_type| of knot~0 and the |mp_right_type| of knot~|n| -are equal to |endpoint|. In the latter case the |link| in knot~|n| points -to knot~0, and the control points $z_0^-$ and $z_n^+$ are not used. - -@d mp_left_type(A) mp->mem[(A)].hh.b0 /* characterizes the path entering this knot */ -@d mp_right_type(A) mp->mem[(A)].hh.b1 /* characterizes the path leaving this knot */ -@d mp_x_coord(A) mp->mem[(A)+1].sc /* the |x| coordinate of this knot */ -@d mp_y_coord(A) mp->mem[(A)+2].sc /* the |y| coordinate of this knot */ -@d mp_left_x(A) mp->mem[(A)+3].sc /* the |x| coordinate of previous control point */ -@d mp_left_y(A) mp->mem[(A)+4].sc /* the |y| coordinate of previous control point */ -@d mp_right_x(A) mp->mem[(A)+5].sc /* the |x| coordinate of next control point */ -@d mp_right_y(A) mp->mem[(A)+6].sc /* the |y| coordinate of next control point */ -@d x_loc(A) ((A)+1) /* where the |x| coordinate is stored in a knot */ -@d y_loc(A) ((A)+2) /* where the |y| coordinate is stored in a knot */ -@d knot_coord(A) mp->mem[(A)].sc /* |x| or |y| coordinate given |x_loc| or |y_loc| */ -@d left_coord(A) mp->mem[(A)+2].sc - /* coordinate of previous control point given |x_loc| or |y_loc| */ -@d right_coord(A) mp->mem[(A)+4].sc - /* coordinate of next control point given |x_loc| or |y_loc| */ -@d knot_node_size 8 /* number of words in a knot node */ - -@(mplib.h@>= -enum mp_knot_type { - mp_endpoint=0, /* |mp_left_type| at path beginning and |mp_right_type| at path end */ - mp_explicit, /* |mp_left_type| or |mp_right_type| when control points are known */ - mp_given, /* |mp_left_type| or |mp_right_type| when a direction is given */ - mp_curl, /* |mp_left_type| or |mp_right_type| when a curl is desired */ - mp_open, /* |mp_left_type| or |mp_right_type| when \MP\ should choose the direction */ - mp_end_cycle -}; - -@ Before the B\'ezier control points have been calculated, the memory -space they will ultimately occupy is taken up by information that can be -used to compute them. There are four cases: - -\yskip -\textindent{$\bullet$} If |mp_right_type=mp_open|, the curve should leave -the knot in the same direction it entered; \MP\ will figure out a -suitable direction. - -\yskip -\textindent{$\bullet$} If |mp_right_type=mp_curl|, the curve should leave the -knot in a direction depending on the angle at which it enters the next -knot and on the curl parameter stored in |right_curl|. - -\yskip -\textindent{$\bullet$} If |mp_right_type=mp_given|, the curve should leave the -knot in a nonzero direction stored as an |angle| in |right_given|. - -\yskip -\textindent{$\bullet$} If |mp_right_type=mp_explicit|, the B\'ezier control -point for leaving this knot has already been computed; it is in the -|mp_right_x| and |mp_right_y| fields. - -\yskip\noindent -The rules for |mp_left_type| are similar, but they refer to the curve entering -the knot, and to \\{left} fields instead of \\{right} fields. - -Non-|explicit| control points will be chosen based on ``tension'' parameters -in the |left_tension| and |right_tension| fields. The -`\&{atleast}' option is represented by negative tension values. -@:at_least_}{\&{atleast} primitive@> - -For example, the \MP\ path specification -$$\.{z0..z1..tension atleast 1..\{curl 2\}z2..z3\{-1,-2\}..tension - 3 and 4..p},$$ -where \.p is the path `\.{z4..controls z45 and z54..z5}', will be represented -by the six knots -\def\lodash{\hbox to 1.1em{\thinspace\hrulefill\thinspace}} -$$\vbox{\halign{#\hfil&&\qquad#\hfil\cr -|mp_left_type|&\\{left} info&|mp_x_coord,mp_y_coord|&|mp_right_type|&\\{right} info\cr -\noalign{\yskip} -|endpoint|&\lodash$,\,$\lodash&$x_0,y_0$&|curl|&$1.0,1.0$\cr -|open|&\lodash$,1.0$&$x_1,y_1$&|open|&\lodash$,-1.0$\cr -|curl|&$2.0,-1.0$&$x_2,y_2$&|curl|&$2.0,1.0$\cr -|given|&$d,1.0$&$x_3,y_3$&|given|&$d,3.0$\cr -|open|&\lodash$,4.0$&$x_4,y_4$&|explicit|&$x_{45},y_{45}$\cr -|explicit|&$x_{54},y_{54}$&$x_5,y_5$&|endpoint|&\lodash$,\,$\lodash\cr}}$$ -Here |d| is the |angle| obtained by calling |n_arg(-unity,-two)|. -Of course, this example is more complicated than anything a normal user -would ever write. - -These types must satisfy certain restrictions because of the form of \MP's -path syntax: -(i)~|open| type never appears in the same node together with |endpoint|, -|given|, or |curl|. -(ii)~The |mp_right_type| of a node is |explicit| if and only if the -|mp_left_type| of the following node is |explicit|. -(iii)~|endpoint| types occur only at the ends, as mentioned above. - -@d left_curl mp_left_x /* curl information when entering this knot */ -@d left_given mp_left_x /* given direction when entering this knot */ -@d left_tension mp_left_y /* tension information when entering this knot */ -@d right_curl mp_right_x /* curl information when leaving this knot */ -@d right_given mp_right_x /* given direction when leaving this knot */ -@d right_tension mp_right_y /* tension information when leaving this knot */ - -@ Knots can be user-supplied, or they can be created by program code, -like the |split_cubic| function, or |copy_path|. The distinction is -needed for the cleanup routine that runs after |split_cubic|, because -it should only delete knots it has previously inserted, and never -anything that was user-supplied. In order to be able to differentiate -one knot from another, we will set |originator(p):=mp_metapost_user| when -it appeared in the actual metapost program, and -|originator(p):=mp_program_code| in all other cases. - -@d mp_originator(A) mp->mem[(A)+7].hh.b0 /* the creator of this knot */ - -@<Exported types@>= -enum mp_knot_originator { - mp_program_code=0, /* not created by a user */ - mp_metapost_user /* created by a user */ -}; - -@ Here is a routine that prints a given knot list -in symbolic form. It illustrates the conventions discussed above, -and checks for anomalies that might arise while \MP\ is being debugged. - -@<Declarations@>= -static void mp_pr_path (MP mp,pointer h); - -@ @c -void mp_pr_path (MP mp,pointer h) { - pointer p,q; /* for list traversal */ - p=h; - do { - q=mp_link(p); - if ( (p==null)||(q==null) ) { - mp_print_nl(mp, "???"); return; /* this won't happen */ -@.???@> - } - @<Print information for adjacent knots |p| and |q|@>; - DONE1: - p=q; - if ( (p!=h)||(mp_left_type(h)!=mp_endpoint) ) { - @<Print two dots, followed by |given| or |curl| if present@>; - } - } while (p!=h); - if ( mp_left_type(h)!=mp_endpoint ) - mp_print(mp, "cycle"); -} - -@ @<Print information for adjacent knots...@>= -mp_print_two(mp, mp_x_coord(p),mp_y_coord(p)); -switch (mp_right_type(p)) { -case mp_endpoint: - if ( mp_left_type(p)==mp_open ) mp_print(mp, "{open?}"); /* can't happen */ -@.open?@> - if ( (mp_left_type(q)!=mp_endpoint)||(q!=h) ) q=null; /* force an error */ - goto DONE1; - break; -case mp_explicit: - @<Print control points between |p| and |q|, then |goto done1|@>; - break; -case mp_open: - @<Print information for a curve that begins |open|@>; - break; -case mp_curl: -case mp_given: - @<Print information for a curve that begins |curl| or |given|@>; - break; -default: - mp_print(mp, "???"); /* can't happen */ -@.???@> - break; -} -if ( mp_left_type(q)<=mp_explicit ) { - mp_print(mp, "..control?"); /* can't happen */ -@.control?@> -} else if ( (right_tension(p)!=unity)||(left_tension(q)!=unity) ) { - @<Print tension between |p| and |q|@>; -} - -@ Since |n_sin_cos| produces |fraction| results, which we will print as if they -were |scaled|, the magnitude of a |given| direction vector will be~4096. - -@<Print two dots...@>= -{ - mp_print_nl(mp, " .."); - if ( mp_left_type(p)==mp_given ) { - mp_n_sin_cos(mp, left_given(p)); mp_print_char(mp, xord('{')); - mp_print_scaled(mp, mp->n_cos); mp_print_char(mp, xord(',')); - mp_print_scaled(mp, mp->n_sin); mp_print_char(mp, xord('}')); - } else if ( mp_left_type(p)==mp_curl ){ - mp_print(mp, "{curl "); - mp_print_scaled(mp, left_curl(p)); mp_print_char(mp, xord('}')); - } -} - -@ @<Print tension between |p| and |q|@>= -{ - mp_print(mp, "..tension "); - if ( right_tension(p)<0 ) mp_print(mp, "atleast"); - mp_print_scaled(mp, abs(right_tension(p))); - if ( right_tension(p)!=left_tension(q) ){ - mp_print(mp, " and "); - if ( left_tension(q)<0 ) mp_print(mp, "atleast"); - mp_print_scaled(mp, abs(left_tension(q))); - } -} - -@ @<Print control points between |p| and |q|, then |goto done1|@>= -{ - mp_print(mp, "..controls "); - mp_print_two(mp, mp_right_x(p),mp_right_y(p)); - mp_print(mp, " and "); - if ( mp_left_type(q)!=mp_explicit ) { - mp_print(mp, "??"); /* can't happen */ -@.??@> - } else { - mp_print_two(mp, mp_left_x(q),mp_left_y(q)); - } - goto DONE1; -} - -@ @<Print information for a curve that begins |open|@>= -if ( (mp_left_type(p)!=mp_explicit)&&(mp_left_type(p)!=mp_open) ) { - mp_print(mp, "{open?}"); /* can't happen */ -@.open?@> -} - -@ A curl of 1 is shown explicitly, so that the user sees clearly that -\MP's default curl is present. - -@<Print information for a curve that begins |curl|...@>= -{ - if ( mp_left_type(p)==mp_open ) - mp_print(mp, "??"); /* can't happen */ -@.??@> - if ( mp_right_type(p)==mp_curl ) { - mp_print(mp, "{curl "); mp_print_scaled(mp, right_curl(p)); - } else { - mp_n_sin_cos(mp, right_given(p)); mp_print_char(mp, xord('{')); - mp_print_scaled(mp, mp->n_cos); mp_print_char(mp, xord(',')); - mp_print_scaled(mp, mp->n_sin); - } - mp_print_char(mp, xord('}')); -} - -@ It is convenient to have another version of |pr_path| that prints the path -as a diagnostic message. - -@<Declarations@>= -static void mp_print_path (MP mp,pointer h, const char *s, boolean nuline) ; - -@ @c -void mp_print_path (MP mp,pointer h, const char *s, boolean nuline) { - mp_print_diagnostic(mp, "Path", s, nuline); mp_print_ln(mp); -@.Path at line...@> - mp_pr_path(mp, h); - mp_end_diagnostic(mp, true); -} - -@ If we want to duplicate a knot node, we can say |copy_knot|: - -@c -static pointer mp_copy_knot (MP mp,pointer p) { - pointer q; /* the copy */ - int k; /* runs through the words of a knot node */ - q=mp_get_node(mp, knot_node_size); - for (k=0;k<knot_node_size;k++) { - mp->mem[q+k]=mp->mem[p+k]; - } - mp_originator(q)=mp_originator(p); - return q; -} - -@ The |copy_path| routine makes a clone of a given path. - -@c -static pointer mp_copy_path (MP mp, pointer p) { - pointer q,pp,qq; /* for list manipulation */ - q=mp_copy_knot(mp, p); - qq=q; pp=mp_link(p); - while ( pp!=p ) { - mp_link(qq)=mp_copy_knot(mp, pp); - qq=mp_link(qq); - pp=mp_link(pp); - } - mp_link(qq)=q; - return q; -} - - -@ Just before |ship_out|, knot lists are exported for printing. - -The |gr_XXXX| macros are defined in |mppsout.h|. - -@c -static mp_knot *mp_export_knot (MP mp,pointer p) { - mp_knot *q; /* the copy */ - if (p==null) - return NULL; - q = xmalloc(1, sizeof (mp_knot)); - memset(q,0,sizeof (mp_knot)); - gr_left_type(q) = (unsigned short)mp_left_type(p); - gr_right_type(q) = (unsigned short)mp_right_type(p); - gr_x_coord(q) = mp_x_coord(p); - gr_y_coord(q) = mp_y_coord(p); - gr_left_x(q) = mp_left_x(p); - gr_left_y(q) = mp_left_y(p); - gr_right_x(q) = mp_right_x(p); - gr_right_y(q) = mp_right_y(p); - gr_originator(q) = (unsigned char)mp_originator(p); - return q; -} - -@ The |export_knot_list| routine therefore also makes a clone -of a given path. - -@c -static mp_knot *mp_export_knot_list (MP mp, pointer p) { - mp_knot *q, *qq; /* for list manipulation */ - pointer pp; /* for list manipulation */ - if (p==null) - return NULL; - q=mp_export_knot(mp, p); - qq=q; pp=mp_link(p); - while ( pp!=p ) { - gr_next_knot(qq)=mp_export_knot(mp, pp); - qq=gr_next_knot(qq); - pp=mp_link(pp); - } - gr_next_knot(qq)=q; - return q; -} - - -@ Similarly, there's a way to copy the {\sl reverse\/} of a path. This procedure -returns a pointer to the first node of the copy, if the path is a cycle, -but to the final node of a non-cyclic copy. The global -variable |path_tail| will point to the final node of the original path; -this trick makes it easier to implement `\&{doublepath}'. - -All node types are assumed to be |endpoint| or |explicit| only. - -@c -static pointer mp_htap_ypoc (MP mp,pointer p) { - pointer q,pp,qq,rr; /* for list manipulation */ - q=mp_get_node(mp, knot_node_size); /* this will correspond to |p| */ - qq=q; pp=p; - while (1) { - mp_right_type(qq)=mp_left_type(pp); mp_left_type(qq)=mp_right_type(pp); - mp_x_coord(qq)=mp_x_coord(pp); mp_y_coord(qq)=mp_y_coord(pp); - mp_right_x(qq)=mp_left_x(pp); mp_right_y(qq)=mp_left_y(pp); - mp_left_x(qq)=mp_right_x(pp); mp_left_y(qq)=mp_right_y(pp); - mp_originator(qq)=mp_originator(pp); - if ( mp_link(pp)==p ) { - mp_link(q)=qq; mp->path_tail=pp; return q; - } - rr=mp_get_node(mp, knot_node_size); mp_link(rr)=qq; qq=rr; pp=mp_link(pp); - } -} - -@ @<Glob...@>= -pointer path_tail; /* the node that links to the beginning of a path */ - -@ When a cyclic list of knot nodes is no longer needed, it can be recycled by -calling the following subroutine. - -@<Declarations@>= -static void mp_toss_knot_list (MP mp,pointer p) ; - -@ @c -void mp_toss_knot_list (MP mp,pointer p) { - pointer q; /* the node being freed */ - pointer r; /* the next node */ - q=p; - do { - r=mp_link(q); - mp_free_node(mp, q,knot_node_size); q=r; - } while (q!=p); -} - -@* \[18] Choosing control points. -Now we must actually delve into one of \MP's more difficult routines, -the |make_choices| procedure that chooses angles and control points for -the splines of a curve when the user has not specified them explicitly. -The parameter to |make_choices| points to a list of knots and -path information, as described above. - -A path decomposes into independent segments at ``breakpoint'' knots, -which are knots whose left and right angles are both prespecified in -some way (i.e., their |mp_left_type| and |mp_right_type| aren't both open). - -@c -static void mp_make_choices (MP mp,pointer knots) { - pointer h; /* the first breakpoint */ - pointer p,q; /* consecutive breakpoints being processed */ - @<Other local variables for |make_choices|@>; - check_arith; /* make sure that |arith_error=false| */ - if ( mp->internal[mp_tracing_choices]>0 ) - mp_print_path(mp, knots,", before choices",true); - @<If consecutive knots are equal, join them explicitly@>; - @<Find the first breakpoint, |h|, on the path; - insert an artificial breakpoint if the path is an unbroken cycle@>; - p=h; - do { - @<Fill in the control points between |p| and the next breakpoint, - then advance |p| to that breakpoint@>; - } while (p!=h); - if ( mp->internal[mp_tracing_choices]>0 ) - mp_print_path(mp, knots,", after choices",true); - if ( mp->arith_error ) { - @<Report an unexpected problem during the choice-making@>; - } -} - -@ @<Report an unexpected problem during the choice...@>= -{ - print_err("Some number got too big"); -@.Some number got too big@> - help2("The path that I just computed is out of range.", - "So it will probably look funny. Proceed, for a laugh."); - mp_put_get_error(mp); mp->arith_error=false; -} - -@ Two knots in a row with the same coordinates will always be joined -by an explicit ``curve'' whose control points are identical with the -knots. - -@<If consecutive knots are equal, join them explicitly@>= -p=knots; -do { - q=mp_link(p); - if ( mp_x_coord(p)==mp_x_coord(q) && - mp_y_coord(p)==mp_y_coord(q) && mp_right_type(p)>mp_explicit ) { - mp_right_type(p)=mp_explicit; - if ( mp_left_type(p)==mp_open ) { - mp_left_type(p)=mp_curl; left_curl(p)=unity; - } - mp_left_type(q)=mp_explicit; - if ( mp_right_type(q)==mp_open ) { - mp_right_type(q)=mp_curl; right_curl(q)=unity; - } - mp_right_x(p)=mp_x_coord(p); mp_left_x(q)=mp_x_coord(p); - mp_right_y(p)=mp_y_coord(p); mp_left_y(q)=mp_y_coord(p); - } - p=q; -} while (p!=knots) - -@ If there are no breakpoints, it is necessary to compute the direction -angles around an entire cycle. In this case the |mp_left_type| of the first -node is temporarily changed to |end_cycle|. - -@<Find the first breakpoint, |h|, on the path...@>= -h=knots; -while (1) { - if ( mp_left_type(h)!=mp_open ) break; - if ( mp_right_type(h)!=mp_open ) break; - h=mp_link(h); - if ( h==knots ) { - mp_left_type(h)=mp_end_cycle; break; - } -} - -@ If |mp_right_type(p)<given| and |q=mp_link(p)|, we must have -|mp_right_type(p)=mp_left_type(q)=mp_explicit| or |endpoint|. - -@<Fill in the control points between |p| and the next breakpoint...@>= -q=mp_link(p); -if ( mp_right_type(p)>=mp_given ) { - while ( (mp_left_type(q)==mp_open)&&(mp_right_type(q)==mp_open) ) q=mp_link(q); - @<Fill in the control information between - consecutive breakpoints |p| and |q|@>; -} else if ( mp_right_type(p)==mp_endpoint ) { - @<Give reasonable values for the unused control points between |p| and~|q|@>; -} -p=q - -@ This step makes it possible to transform an explicitly computed path without -checking the |mp_left_type| and |mp_right_type| fields. - -@<Give reasonable values for the unused control points between |p| and~|q|@>= -{ - mp_right_x(p)=mp_x_coord(p); mp_right_y(p)=mp_y_coord(p); - mp_left_x(q)=mp_x_coord(q); mp_left_y(q)=mp_y_coord(q); -} - -@ Before we can go further into the way choices are made, we need to -consider the underlying theory. The basic ideas implemented in |make_choices| -are due to John Hobby, who introduced the notion of ``mock curvature'' -@^Hobby, John Douglas@> -at a knot. Angles are chosen so that they preserve mock curvature when -a knot is passed, and this has been found to produce excellent results. - -It is convenient to introduce some notations that simplify the necessary -formulas. Let $d_{k,k+1}=\vert z\k-z_k\vert$ be the (nonzero) distance -between knots |k| and |k+1|; and let -$${z\k-z_k\over z_k-z_{k-1}}={d_{k,k+1}\over d_{k-1,k}}e^{i\psi_k}$$ -so that a polygonal line from $z_{k-1}$ to $z_k$ to $z\k$ turns left -through an angle of~$\psi_k$. We assume that $\vert\psi_k\vert\L180^\circ$. -The control points for the spline from $z_k$ to $z\k$ will be denoted by -$$\eqalign{z_k^+&=z_k+ - \textstyle{1\over3}\rho_k e^{i\theta_k}(z\k-z_k),\cr - z\k^-&=z\k- - \textstyle{1\over3}\sigma\k e^{-i\phi\k}(z\k-z_k),\cr}$$ -where $\rho_k$ and $\sigma\k$ are nonnegative ``velocity ratios'' at the -beginning and end of the curve, while $\theta_k$ and $\phi\k$ are the -corresponding ``offset angles.'' These angles satisfy the condition -$$\theta_k+\phi_k+\psi_k=0,\eqno(*)$$ -whenever the curve leaves an intermediate knot~|k| in the direction that -it enters. - -@ Let $\alpha_k$ and $\beta\k$ be the reciprocals of the ``tension'' of -the curve at its beginning and ending points. This means that -$\rho_k=\alpha_k f(\theta_k,\phi\k)$ and $\sigma\k=\beta\k f(\phi\k,\theta_k)$, -where $f(\theta,\phi)$ is \MP's standard velocity function defined in -the |velocity| subroutine. The cubic spline $B(z_k^{\phantom+},z_k^+, -z\k^-,z\k^{\phantom+};t)$ -has curvature -@^curvature@> -$${2\sigma\k\sin(\theta_k+\phi\k)-6\sin\theta_k\over\rho_k^2d_{k,k+1}} -\qquad{\rm and}\qquad -{2\rho_k\sin(\theta_k+\phi\k)-6\sin\phi\k\over\sigma\k^2d_{k,k+1}}$$ -at |t=0| and |t=1|, respectively. The mock curvature is the linear -@^mock curvature@> -approximation to this true curvature that arises in the limit for -small $\theta_k$ and~$\phi\k$, if second-order terms are discarded. -The standard velocity function satisfies -$$f(\theta,\phi)=1+O(\theta^2+\theta\phi+\phi^2);$$ -hence the mock curvatures are respectively -$${2\beta\k(\theta_k+\phi\k)-6\theta_k\over\alpha_k^2d_{k,k+1}} -\qquad{\rm and}\qquad -{2\alpha_k(\theta_k+\phi\k)-6\phi\k\over\beta\k^2d_{k,k+1}}.\eqno(**)$$ - -@ The turning angles $\psi_k$ are given, and equation $(*)$ above -determines $\phi_k$ when $\theta_k$ is known, so the task of -angle selection is essentially to choose appropriate values for each -$\theta_k$. When equation~$(*)$ is used to eliminate $\phi$~variables -from $(**)$, we obtain a system of linear equations of the form -$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k,$$ -where -$$A_k={\alpha_{k-1}\over\beta_k^2d_{k-1,k}}, -\qquad B_k={3-\alpha_{k-1}\over\beta_k^2d_{k-1,k}}, -\qquad C_k={3-\beta\k\over\alpha_k^2d_{k,k+1}}, -\qquad D_k={\beta\k\over\alpha_k^2d_{k,k+1}}.$$ -The tensions are always $3\over4$ or more, hence each $\alpha$ and~$\beta$ -will be at most $4\over3$. It follows that $B_k\G{5\over4}A_k$ and -$C_k\G{5\over4}D_k$; hence the equations are diagonally dominant; -hence they have a unique solution. Moreover, in most cases the tensions -are equal to~1, so that $B_k=2A_k$ and $C_k=2D_k$. This makes the -solution numerically stable, and there is an exponential damping -effect: The data at knot $k\pm j$ affects the angle at knot~$k$ by -a factor of~$O(2^{-j})$. - -@ However, we still must consider the angles at the starting and ending -knots of a non-cyclic path. These angles might be given explicitly, or -they might be specified implicitly in terms of an amount of ``curl.'' - -Let's assume that angles need to be determined for a non-cyclic path -starting at $z_0$ and ending at~$z_n$. Then equations of the form -$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta_{k+1}=R_k$$ -have been given for $0<k<n$, and it will be convenient to introduce -equations of the same form for $k=0$ and $k=n$, where -$$A_0=B_0=C_n=D_n=0.$$ -If $\theta_0$ is supposed to have a given value $E_0$, we simply -define $C_0=1$, $D_0=0$, and $R_0=E_0$. Otherwise a curl -parameter, $\gamma_0$, has been specified at~$z_0$; this means -that the mock curvature at $z_0$ should be $\gamma_0$ times the -mock curvature at $z_1$; i.e., -$${2\beta_1(\theta_0+\phi_1)-6\theta_0\over\alpha_0^2d_{01}} -=\gamma_0{2\alpha_0(\theta_0+\phi_1)-6\phi_1\over\beta_1^2d_{01}}.$$ -This equation simplifies to -$$(\alpha_0\chi_0+3-\beta_1)\theta_0+ - \bigl((3-\alpha_0)\chi_0+\beta_1\bigr)\theta_1= - -\bigl((3-\alpha_0)\chi_0+\beta_1\bigr)\psi_1,$$ -where $\chi_0=\alpha_0^2\gamma_0/\beta_1^2$; so we can set $C_0= -\chi_0\alpha_0+3-\beta_1$, $D_0=(3-\alpha_0)\chi_0+\beta_1$, $R_0=-D_0\psi_1$. -It can be shown that $C_0>0$ and $C_0B_1-A_1D_0>0$ when $\gamma_0\G0$, -hence the linear equations remain nonsingular. - -Similar considerations apply at the right end, when the final angle $\phi_n$ -may or may not need to be determined. It is convenient to let $\psi_n=0$, -hence $\theta_n=-\phi_n$. We either have an explicit equation $\theta_n=E_n$, -or we have -$$\bigl((3-\beta_n)\chi_n+\alpha_{n-1}\bigr)\theta_{n-1}+ -(\beta_n\chi_n+3-\alpha_{n-1})\theta_n=0,\qquad - \chi_n={\beta_n^2\gamma_n\over\alpha_{n-1}^2}.$$ - -When |make_choices| chooses angles, it must compute the coefficients of -these linear equations, then solve the equations. To compute the coefficients, -it is necessary to compute arctangents of the given turning angles~$\psi_k$. -When the equations are solved, the chosen directions $\theta_k$ are put -back into the form of control points by essentially computing sines and -cosines. - -@ OK, we are ready to make the hard choices of |make_choices|. -Most of the work is relegated to an auxiliary procedure -called |solve_choices|, which has been introduced to keep -|make_choices| from being extremely long. - -@<Fill in the control information between...@>= -@<Calculate the turning angles $\psi_k$ and the distances $d_{k,k+1}$; - set $n$ to the length of the path@>; -@<Remove |open| types at the breakpoints@>; -mp_solve_choices(mp, p,q,n) - -@ It's convenient to precompute quantities that will be needed several -times later. The values of |delta_x[k]| and |delta_y[k]| will be the -coordinates of $z\k-z_k$, and the magnitude of this vector will be -|delta[k]=@t$d_{k,k+1}$@>|. The path angle $\psi_k$ between $z_k-z_{k-1}$ -and $z\k-z_k$ will be stored in |psi[k]|. - -@<Glob...@>= -int path_size; /* maximum number of knots between breakpoints of a path */ -scaled *delta_x; -scaled *delta_y; -scaled *delta; /* knot differences */ -angle *psi; /* turning angles */ - -@ @<Dealloc variables@>= -xfree(mp->delta_x); -xfree(mp->delta_y); -xfree(mp->delta); -xfree(mp->psi); - -@ @<Other local variables for |make_choices|@>= - int k,n; /* current and final knot numbers */ - pointer s,t; /* registers for list traversal */ - scaled delx,dely; /* directions where |open| meets |explicit| */ - fraction sine,cosine; /* trig functions of various angles */ - -@ @<Calculate the turning angles...@>= -{ -RESTART: - k=0; s=p; n=mp->path_size; - do { - t=mp_link(s); - mp->delta_x[k]=mp_x_coord(t)-mp_x_coord(s); - mp->delta_y[k]=mp_y_coord(t)-mp_y_coord(s); - mp->delta[k]=mp_pyth_add(mp, mp->delta_x[k],mp->delta_y[k]); - if ( k>0 ) { - sine=mp_make_fraction(mp, mp->delta_y[k-1],mp->delta[k-1]); - cosine=mp_make_fraction(mp, mp->delta_x[k-1],mp->delta[k-1]); - mp->psi[k]=mp_n_arg(mp, mp_take_fraction(mp, mp->delta_x[k],cosine)+ - mp_take_fraction(mp, mp->delta_y[k],sine), - mp_take_fraction(mp, mp->delta_y[k],cosine)- - mp_take_fraction(mp, mp->delta_x[k],sine)); - } - incr(k); s=t; - if ( k==mp->path_size ) { - mp_reallocate_paths(mp, mp->path_size+(mp->path_size/4)); - goto RESTART; /* retry, loop size has changed */ - } - if ( s==q ) n=k; - } while (!((k>=n)&&(mp_left_type(s)!=mp_end_cycle))); - if ( k==n ) mp->psi[n]=0; else mp->psi[k]=mp->psi[1]; -} - -@ When we get to this point of the code, |mp_right_type(p)| is either -|given| or |curl| or |open|. If it is |open|, we must have -|mp_left_type(p)=mp_end_cycle| or |mp_left_type(p)=mp_explicit|. In the latter -case, the |open| type is converted to |given|; however, if the -velocity coming into this knot is zero, the |open| type is -converted to a |curl|, since we don't know the incoming direction. - -Similarly, |mp_left_type(q)| is either |given| or |curl| or |open| or -|mp_end_cycle|. The |open| possibility is reduced either to |given| or to |curl|. - -@<Remove |open| types at the breakpoints@>= -if ( mp_left_type(q)==mp_open ) { - delx=mp_right_x(q)-mp_x_coord(q); dely=mp_right_y(q)-mp_y_coord(q); - if ( (delx==0)&&(dely==0) ) { - mp_left_type(q)=mp_curl; left_curl(q)=unity; - } else { - mp_left_type(q)=mp_given; left_given(q)=mp_n_arg(mp, delx,dely); - } -} -if ( (mp_right_type(p)==mp_open)&&(mp_left_type(p)==mp_explicit) ) { - delx=mp_x_coord(p)-mp_left_x(p); dely=mp_y_coord(p)-mp_left_y(p); - if ( (delx==0)&&(dely==0) ) { - mp_right_type(p)=mp_curl; right_curl(p)=unity; - } else { - mp_right_type(p)=mp_given; right_given(p)=mp_n_arg(mp, delx,dely); - } -} - -@ Linear equations need to be solved whenever |n>1|; and also when |n=1| -and exactly one of the breakpoints involves a curl. The simplest case occurs -when |n=1| and there is a curl at both breakpoints; then we simply draw -a straight line. - -But before coding up the simple cases, we might as well face the general case, -since we must deal with it sooner or later, and since the general case -is likely to give some insight into the way simple cases can be handled best. - -When there is no cycle, the linear equations to be solved form a tridiagonal -system, and we can apply the standard technique of Gaussian elimination -to convert that system to a sequence of equations of the form -$$\theta_0+u_0\theta_1=v_0,\quad -\theta_1+u_1\theta_2=v_1,\quad\ldots,\quad -\theta_{n-1}+u_{n-1}\theta_n=v_{n-1},\quad -\theta_n=v_n.$$ -It is possible to do this diagonalization while generating the equations. -Once $\theta_n$ is known, it is easy to determine $\theta_{n-1}$, \dots, -$\theta_1$, $\theta_0$; thus, the equations will be solved. - -The procedure is slightly more complex when there is a cycle, but the -basic idea will be nearly the same. In the cyclic case the right-hand -sides will be $v_k+w_k\theta_0$ instead of simply $v_k$, and we will start -the process off with $u_0=v_0=0$, $w_0=1$. The final equation will be not -$\theta_n=v_n$ but $\theta_n+u_n\theta_1=v_n+w_n\theta_0$; an appropriate -ending routine will take account of the fact that $\theta_n=\theta_0$ and -eliminate the $w$'s from the system, after which the solution can be -obtained as before. - -When $u_k$, $v_k$, and $w_k$ are being computed, the three pointer -variables |r|, |s|,~|t| will point respectively to knots |k-1|, |k|, -and~|k+1|. The $u$'s and $w$'s are scaled by $2^{28}$, i.e., they are -of type |fraction|; the $\theta$'s and $v$'s are of type |angle|. - -@<Glob...@>= -angle *theta; /* values of $\theta_k$ */ -fraction *uu; /* values of $u_k$ */ -angle *vv; /* values of $v_k$ */ -fraction *ww; /* values of $w_k$ */ - -@ @<Dealloc variables@>= -xfree(mp->theta); -xfree(mp->uu); -xfree(mp->vv); -xfree(mp->ww); - -@ @<Declarations@>= -static void mp_reallocate_paths (MP mp, int l); - -@ @c -void mp_reallocate_paths (MP mp, int l) { - XREALLOC (mp->delta_x, l, scaled); - XREALLOC (mp->delta_y, l, scaled); - XREALLOC (mp->delta, l, scaled); - XREALLOC (mp->psi, l, angle); - XREALLOC (mp->theta, l, angle); - XREALLOC (mp->uu, l, fraction); - XREALLOC (mp->vv, l, angle); - XREALLOC (mp->ww, l, fraction); - mp->path_size = l; -} - -@ Our immediate problem is to get the ball rolling by setting up the -first equation or by realizing that no equations are needed, and to fit -this initialization into a framework suitable for the overall computation. - -@<Declarations@>= -static void mp_solve_choices (MP mp,pointer p, pointer q, halfword n) ; - -@ @c -void mp_solve_choices (MP mp,pointer p, pointer q, halfword n) { - int k; /* current knot number */ - pointer r,s,t; /* registers for list traversal */ - @<Other local variables for |solve_choices|@>; - k=0; s=p; r=0; - while (1) { - t=mp_link(s); - if ( k==0 ) { - @<Get the linear equations started; or |return| - with the control points in place, if linear equations - needn't be solved@> - } else { - switch (mp_left_type(s)) { - case mp_end_cycle: case mp_open: - @<Set up equation to match mock curvatures - at $z_k$; then |goto found| with $\theta_n$ - adjusted to equal $\theta_0$, if a cycle has ended@>; - break; - case mp_curl: - @<Set up equation for a curl at $\theta_n$ - and |goto found|@>; - break; - case mp_given: - @<Calculate the given value of $\theta_n$ - and |goto found|@>; - break; - } /* there are no other cases */ - } - r=s; s=t; incr(k); - } -FOUND: - @<Finish choosing angles and assigning control points@>; -} - -@ On the first time through the loop, we have |k=0| and |r| is not yet -defined. The first linear equation, if any, will have $A_0=B_0=0$. - -@<Get the linear equations started...@>= -switch (mp_right_type(s)) { -case mp_given: - if ( mp_left_type(t)==mp_given ) { - @<Reduce to simple case of two givens and |return|@> - } else { - @<Set up the equation for a given value of $\theta_0$@>; - } - break; -case mp_curl: - if ( mp_left_type(t)==mp_curl ) { - @<Reduce to simple case of straight line and |return|@> - } else { - @<Set up the equation for a curl at $\theta_0$@>; - } - break; -case mp_open: - mp->uu[0]=0; mp->vv[0]=0; mp->ww[0]=fraction_one; - /* this begins a cycle */ - break; -} /* there are no other cases */ - -@ The general equation that specifies equality of mock curvature at $z_k$ is -$$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k,$$ -as derived above. We want to combine this with the already-derived equation -$\theta_{k-1}+u_{k-1}\theta_k=v_{k-1}+w_{k-1}\theta_0$ in order to obtain -a new equation -$\theta_k+u_k\theta\k=v_k+w_k\theta_0$. This can be done by dividing the -equation -$$(B_k-u_{k-1}A_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k-A_kv_{k-1} - -A_kw_{k-1}\theta_0$$ -by $B_k-u_{k-1}A_k+C_k$. The trick is to do this carefully with -fixed-point arithmetic, avoiding the chance of overflow while retaining -suitable precision. - -The calculations will be performed in several registers that -provide temporary storage for intermediate quantities. - -@<Other local variables for |solve_choices|@>= -fraction aa,bb,cc,ff,acc; /* temporary registers */ -scaled dd,ee; /* likewise, but |scaled| */ -scaled lt,rt; /* tension values */ - -@ @<Set up equation to match mock curvatures...@>= -{ @<Calculate the values $\\{aa}=A_k/B_k$, $\\{bb}=D_k/C_k$, - $\\{dd}=(3-\alpha_{k-1})d_{k,k+1}$, $\\{ee}=(3-\beta\k)d_{k-1,k}$, - and $\\{cc}=(B_k-u_{k-1}A_k)/B_k$@>; - @<Calculate the ratio $\\{ff}=C_k/(C_k+B_k-u_{k-1}A_k)$@>; - mp->uu[k]=mp_take_fraction(mp, ff,bb); - @<Calculate the values of $v_k$ and $w_k$@>; - if ( mp_left_type(s)==mp_end_cycle ) { - @<Adjust $\theta_n$ to equal $\theta_0$ and |goto found|@>; - } -} - -@ Since tension values are never less than 3/4, the values |aa| and -|bb| computed here are never more than 4/5. - -@<Calculate the values $\\{aa}=...@>= -if ( abs(right_tension(r))==unity) { - aa=fraction_half; dd=2*mp->delta[k]; -} else { - aa=mp_make_fraction(mp, unity,3*abs(right_tension(r))-unity); - dd=mp_take_fraction(mp, mp->delta[k], - fraction_three-mp_make_fraction(mp, unity,abs(right_tension(r)))); -} -if ( abs(left_tension(t))==unity ){ - bb=fraction_half; ee=2*mp->delta[k-1]; -} else { - bb=mp_make_fraction(mp, unity,3*abs(left_tension(t))-unity); - ee=mp_take_fraction(mp, mp->delta[k-1], - fraction_three-mp_make_fraction(mp, unity,abs(left_tension(t)))); -} -cc=fraction_one-mp_take_fraction(mp, mp->uu[k-1],aa) - -@ The ratio to be calculated in this step can be written in the form -$$\beta_k^2\cdot\\{ee}\over\beta_k^2\cdot\\{ee}+\alpha_k^2\cdot - \\{cc}\cdot\\{dd},$$ -because of the quantities just calculated. The values of |dd| and |ee| -will not be needed after this step has been performed. - -@<Calculate the ratio $\\{ff}=C_k/(C_k+B_k-u_{k-1}A_k)$@>= -dd=mp_take_fraction(mp, dd,cc); lt=abs(left_tension(s)); rt=abs(right_tension(s)); -if ( lt!=rt ) { /* $\beta_k^{-1}\ne\alpha_k^{-1}$ */ - if ( lt<rt ) { - ff=mp_make_fraction(mp, lt,rt); - ff=mp_take_fraction(mp, ff,ff); /* $\alpha_k^2/\beta_k^2$ */ - dd=mp_take_fraction(mp, dd,ff); - } else { - ff=mp_make_fraction(mp, rt,lt); - ff=mp_take_fraction(mp, ff,ff); /* $\beta_k^2/\alpha_k^2$ */ - ee=mp_take_fraction(mp, ee,ff); - } -} -ff=mp_make_fraction(mp, ee,ee+dd) - -@ The value of $u_{k-1}$ will be |<=1| except when $k=1$ and the previous -equation was specified by a curl. In that case we must use a special -method of computation to prevent overflow. - -Fortunately, the calculations turn out to be even simpler in this ``hard'' -case. The curl equation makes $w_0=0$ and $v_0=-u_0\psi_1$, hence -$-B_1\psi_1-A_1v_0=-(B_1-u_0A_1)\psi_1=-\\{cc}\cdot B_1\psi_1$. - -@<Calculate the values of $v_k$ and $w_k$@>= -acc=-mp_take_fraction(mp, mp->psi[k+1],mp->uu[k]); -if ( mp_right_type(r)==mp_curl ) { - mp->ww[k]=0; - mp->vv[k]=acc-mp_take_fraction(mp, mp->psi[1],fraction_one-ff); -} else { - ff=mp_make_fraction(mp, fraction_one-ff,cc); /* this is - $B_k/(C_k+B_k-u_{k-1}A_k)<5$ */ - acc=acc-mp_take_fraction(mp, mp->psi[k],ff); - ff=mp_take_fraction(mp, ff,aa); /* this is $A_k/(C_k+B_k-u_{k-1}A_k)$ */ - mp->vv[k]=acc-mp_take_fraction(mp, mp->vv[k-1],ff); - if ( mp->ww[k-1]==0 ) mp->ww[k]=0; - else mp->ww[k]=-mp_take_fraction(mp, mp->ww[k-1],ff); -} - -@ When a complete cycle has been traversed, we have $\theta_k+u_k\theta\k= -v_k+w_k\theta_0$, for |1<=k<=n|. We would like to determine the value of -$\theta_n$ and reduce the system to the form $\theta_k+u_k\theta\k=v_k$ -for |0<=k<n|, so that the cyclic case can be finished up just as if there -were no cycle. - -The idea in the following code is to observe that -$$\eqalign{\theta_n&=v_n+w_n\theta_0-u_n\theta_1=\cdots\cr -&=v_n+w_n\theta_0-u_n\bigl(v_1+w_1\theta_0-u_1(v_2+\cdots - -u_{n-2}(v_{n-1}+w_{n-1}\theta_0-u_{n-1}\theta_0))\bigr),\cr}$$ -so we can solve for $\theta_n=\theta_0$. - -@<Adjust $\theta_n$ to equal $\theta_0$ and |goto found|@>= -{ -aa=0; bb=fraction_one; /* we have |k=n| */ -do { decr(k); -if ( k==0 ) k=n; - aa=mp->vv[k]-mp_take_fraction(mp, aa,mp->uu[k]); - bb=mp->ww[k]-mp_take_fraction(mp, bb,mp->uu[k]); -} while (k!=n); /* now $\theta_n=\\{aa}+\\{bb}\cdot\theta_n$ */ -aa=mp_make_fraction(mp, aa,fraction_one-bb); -mp->theta[n]=aa; mp->vv[0]=aa; -for (k=1;k<n;k++) { - mp->vv[k]=mp->vv[k]+mp_take_fraction(mp, aa,mp->ww[k]); -} -goto FOUND; -} - -@ @d reduce_angle(A) if ( abs((A))>one_eighty_deg ) { - if ( (A)>0 ) (A)=(A)-three_sixty_deg; else (A)=(A)+three_sixty_deg; } - -@<Calculate the given value of $\theta_n$...@>= -{ - mp->theta[n]=left_given(s)-mp_n_arg(mp, mp->delta_x[n-1],mp->delta_y[n-1]); - reduce_angle(mp->theta[n]); - goto FOUND; -} - -@ @<Set up the equation for a given value of $\theta_0$@>= -{ - mp->vv[0]=right_given(s)-mp_n_arg(mp, mp->delta_x[0],mp->delta_y[0]); - reduce_angle(mp->vv[0]); - mp->uu[0]=0; mp->ww[0]=0; -} - -@ @<Set up the equation for a curl at $\theta_0$@>= -{ cc=right_curl(s); lt=abs(left_tension(t)); rt=abs(right_tension(s)); - if ( (rt==unity)&&(lt==unity) ) - mp->uu[0]=mp_make_fraction(mp, cc+cc+unity,cc+two); - else - mp->uu[0]=mp_curl_ratio(mp, cc,rt,lt); - mp->vv[0]=-mp_take_fraction(mp, mp->psi[1],mp->uu[0]); mp->ww[0]=0; -} - -@ @<Set up equation for a curl at $\theta_n$...@>= -{ cc=left_curl(s); lt=abs(left_tension(s)); rt=abs(right_tension(r)); - if ( (rt==unity)&&(lt==unity) ) - ff=mp_make_fraction(mp, cc+cc+unity,cc+two); - else - ff=mp_curl_ratio(mp, cc,lt,rt); - mp->theta[n]=-mp_make_fraction(mp, mp_take_fraction(mp, mp->vv[n-1],ff), - fraction_one-mp_take_fraction(mp, ff,mp->uu[n-1])); - goto FOUND; -} - -@ The |curl_ratio| subroutine has three arguments, which our previous notation -encourages us to call $\gamma$, $\alpha^{-1}$, and $\beta^{-1}$. It is -a somewhat tedious program to calculate -$${(3-\alpha)\alpha^2\gamma+\beta^3\over - \alpha^3\gamma+(3-\beta)\beta^2},$$ -with the result reduced to 4 if it exceeds 4. (This reduction of curl -is necessary only if the curl and tension are both large.) -The values of $\alpha$ and $\beta$ will be at most~4/3. - -@<Declarations@>= -static fraction mp_curl_ratio (MP mp,scaled gamma, scaled a_tension, - scaled b_tension) ; - -@ @c -fraction mp_curl_ratio (MP mp,scaled gamma, scaled a_tension, - scaled b_tension) { - fraction alpha,beta,num,denom,ff; /* registers */ - alpha=mp_make_fraction(mp, unity,a_tension); - beta=mp_make_fraction(mp, unity,b_tension); - if ( alpha<=beta ) { - ff=mp_make_fraction(mp, alpha,beta); ff=mp_take_fraction(mp, ff,ff); - gamma=mp_take_fraction(mp, gamma,ff); - beta=beta / 010000; /* convert |fraction| to |scaled| */ - denom=mp_take_fraction(mp, gamma,alpha)+three-beta; - num=mp_take_fraction(mp, gamma,fraction_three-alpha)+beta; - } else { - ff=mp_make_fraction(mp, beta,alpha); ff=mp_take_fraction(mp, ff,ff); - beta=mp_take_fraction(mp, beta,ff) / 010000; /* convert |fraction| to |scaled| */ - denom=mp_take_fraction(mp, gamma,alpha)+(ff / 1365)-beta; - /* $1365\approx 2^{12}/3$ */ - num=mp_take_fraction(mp, gamma,fraction_three-alpha)+beta; - } - if ( num>=denom+denom+denom+denom ) return fraction_four; - else return mp_make_fraction(mp, num,denom); -} - -@ We're in the home stretch now. - -@<Finish choosing angles and assigning control points@>= -for (k=n-1;k>=0;k--) { - mp->theta[k]=mp->vv[k]-mp_take_fraction(mp,mp->theta[k+1],mp->uu[k]); -} -s=p; k=0; -do { - t=mp_link(s); - mp_n_sin_cos(mp, mp->theta[k]); mp->st=mp->n_sin; mp->ct=mp->n_cos; - mp_n_sin_cos(mp, -mp->psi[k+1]-mp->theta[k+1]); mp->sf=mp->n_sin; mp->cf=mp->n_cos; - mp_set_controls(mp, s,t,k); - incr(k); s=t; -} while (k!=n) - -@ The |set_controls| routine actually puts the control points into -a pair of consecutive nodes |p| and~|q|. Global variables are used to -record the values of $\sin\theta$, $\cos\theta$, $\sin\phi$, and -$\cos\phi$ needed in this calculation. - -@<Glob...@>= -fraction st; -fraction ct; -fraction sf; -fraction cf; /* sines and cosines */ - -@ @<Declarations@>= -static void mp_set_controls (MP mp,pointer p, pointer q, integer k); - -@ @c -void mp_set_controls (MP mp,pointer p, pointer q, integer k) { - fraction rr,ss; /* velocities, divided by thrice the tension */ - scaled lt,rt; /* tensions */ - fraction sine; /* $\sin(\theta+\phi)$ */ - lt=abs(left_tension(q)); rt=abs(right_tension(p)); - rr=mp_velocity(mp, mp->st,mp->ct,mp->sf,mp->cf,rt); - ss=mp_velocity(mp, mp->sf,mp->cf,mp->st,mp->ct,lt); - if ( (right_tension(p)<0)||(left_tension(q)<0) ) { - @<Decrease the velocities, - if necessary, to stay inside the bounding triangle@>; - } - mp_right_x(p)=mp_x_coord(p)+mp_take_fraction(mp, - mp_take_fraction(mp, mp->delta_x[k],mp->ct)- - mp_take_fraction(mp, mp->delta_y[k],mp->st),rr); - mp_right_y(p)=mp_y_coord(p)+mp_take_fraction(mp, - mp_take_fraction(mp, mp->delta_y[k],mp->ct)+ - mp_take_fraction(mp, mp->delta_x[k],mp->st),rr); - mp_left_x(q)=mp_x_coord(q)-mp_take_fraction(mp, - mp_take_fraction(mp, mp->delta_x[k],mp->cf)+ - mp_take_fraction(mp, mp->delta_y[k],mp->sf),ss); - mp_left_y(q)=mp_y_coord(q)-mp_take_fraction(mp, - mp_take_fraction(mp, mp->delta_y[k],mp->cf)- - mp_take_fraction(mp, mp->delta_x[k],mp->sf),ss); - mp_right_type(p)=mp_explicit; mp_left_type(q)=mp_explicit; -} - -@ The boundedness conditions $\\{rr}\L\sin\phi\,/\sin(\theta+\phi)$ and -$\\{ss}\L\sin\theta\,/\sin(\theta+\phi)$ are to be enforced if $\sin\theta$, -$\sin\phi$, and $\sin(\theta+\phi)$ all have the same sign. Otherwise -there is no ``bounding triangle.'' - -@<Decrease the velocities, if necessary...@>= -if (((mp->st>=0)&&(mp->sf>=0))||((mp->st<=0)&&(mp->sf<=0)) ) { - sine=mp_take_fraction(mp, abs(mp->st),mp->cf)+ - mp_take_fraction(mp, abs(mp->sf),mp->ct); - if ( sine>0 ) { - sine=mp_take_fraction(mp, sine,fraction_one+unity); /* safety factor */ - if ( right_tension(p)<0 ) - if ( mp_ab_vs_cd(mp, abs(mp->sf),fraction_one,rr,sine)<0 ) - rr=mp_make_fraction(mp, abs(mp->sf),sine); - if ( left_tension(q)<0 ) - if ( mp_ab_vs_cd(mp, abs(mp->st),fraction_one,ss,sine)<0 ) - ss=mp_make_fraction(mp, abs(mp->st),sine); - } -} - -@ Only the simple cases remain to be handled. - -@<Reduce to simple case of two givens and |return|@>= -{ - aa=mp_n_arg(mp, mp->delta_x[0],mp->delta_y[0]); - mp_n_sin_cos(mp, right_given(p)-aa); mp->ct=mp->n_cos; mp->st=mp->n_sin; - mp_n_sin_cos(mp, left_given(q)-aa); mp->cf=mp->n_cos; mp->sf=-mp->n_sin; - mp_set_controls(mp, p,q,0); return; -} - -@ @<Reduce to simple case of straight line and |return|@>= -{ - mp_right_type(p)=mp_explicit; mp_left_type(q)=mp_explicit; - lt=abs(left_tension(q)); rt=abs(right_tension(p)); - if ( rt==unity ) { - if ( mp->delta_x[0]>=0 ) mp_right_x(p)=mp_x_coord(p)+((mp->delta_x[0]+1) / 3); - else mp_right_x(p)=mp_x_coord(p)+((mp->delta_x[0]-1) / 3); - if ( mp->delta_y[0]>=0 ) mp_right_y(p)=mp_y_coord(p)+((mp->delta_y[0]+1) / 3); - else mp_right_y(p)=mp_y_coord(p)+((mp->delta_y[0]-1) / 3); - } else { - ff=mp_make_fraction(mp, unity,3*rt); /* $\alpha/3$ */ - mp_right_x(p)=mp_x_coord(p)+mp_take_fraction(mp, mp->delta_x[0],ff); - mp_right_y(p)=mp_y_coord(p)+mp_take_fraction(mp, mp->delta_y[0],ff); - } - if ( lt==unity ) { - if ( mp->delta_x[0]>=0 ) mp_left_x(q)=mp_x_coord(q)-((mp->delta_x[0]+1) / 3); - else mp_left_x(q)=mp_x_coord(q)-((mp->delta_x[0]-1) / 3); - if ( mp->delta_y[0]>=0 ) mp_left_y(q)=mp_y_coord(q)-((mp->delta_y[0]+1) / 3); - else mp_left_y(q)=mp_y_coord(q)-((mp->delta_y[0]-1) / 3); - } else { - ff=mp_make_fraction(mp, unity,3*lt); /* $\beta/3$ */ - mp_left_x(q)=mp_x_coord(q)-mp_take_fraction(mp, mp->delta_x[0],ff); - mp_left_y(q)=mp_y_coord(q)-mp_take_fraction(mp, mp->delta_y[0],ff); - } - return; -} - -@* \[19] Measuring paths. -\MP's \&{llcorner}, \&{lrcorner}, \&{ulcorner}, and \&{urcorner} operators -allow the user to measure the bounding box of anything that can go into a -picture. It's easy to get rough bounds on the $x$ and $y$ extent of a path -by just finding the bounding box of the knots and the control points. We -need a more accurate version of the bounding box, but we can still use the -easy estimate to save time by focusing on the interesting parts of the path. - -@ Computing an accurate bounding box involves a theme that will come up again -and again. Given a Bernshte{\u\i}n polynomial -@^Bernshte{\u\i}n, Serge{\u\i} Natanovich@> -$$B(z_0,z_1,\ldots,z_n;t)=\sum_k{n\choose k}t^k(1-t)^{n-k}z_k,$$ -we can conveniently bisect its range as follows: - -\smallskip -\textindent{1)} Let $z_k^{(0)}=z_k$, for |0<=k<=n|. - -\smallskip -\textindent{2)} Let $z_k^{(j+1)}={1\over2}(z_k^{(j)}+z\k^{(j)})$, for -|0<=k<n-j|, for |0<=j<n|. - -\smallskip\noindent -Then -$$B(z_0,z_1,\ldots,z_n;t)=B(z_0^{(0)},z_0^{(1)},\ldots,z_0^{(n)};2t) - =B(z_0^{(n)},z_1^{(n-1)},\ldots,z_n^{(0)};2t-1).$$ -This formula gives us the coefficients of polynomials to use over the ranges -$0\L t\L{1\over2}$ and ${1\over2}\L t\L1$. - -@ Now here's a subroutine that's handy for all sorts of path computations: -Given a quadratic polynomial $B(a,b,c;t)$, the |crossing_point| function -returns the unique |fraction| value |t| between 0 and~1 at which -$B(a,b,c;t)$ changes from positive to negative, or returns -|t=fraction_one+1| if no such value exists. If |a<0| (so that $B(a,b,c;t)$ -is already negative at |t=0|), |crossing_point| returns the value zero. - -@d no_crossing { return (fraction_one+1); } -@d one_crossing { return fraction_one; } -@d zero_crossing { return 0; } -@d mp_crossing_point(M,A,B,C) mp_do_crossing_point(A,B,C) - -@c static fraction mp_do_crossing_point (integer a, integer b, integer c) { - integer d; /* recursive counter */ - integer x,xx,x0,x1,x2; /* temporary registers for bisection */ - if ( a<0 ) zero_crossing; - if ( c>=0 ) { - if ( b>=0 ) { - if ( c>0 ) { no_crossing; } - else if ( (a==0)&&(b==0) ) { no_crossing;} - else { one_crossing; } - } - if ( a==0 ) zero_crossing; - } else if ( a==0 ) { - if ( b<=0 ) zero_crossing; - } - @<Use bisection to find the crossing point, if one exists@>; -} - -@ The general bisection method is quite simple when $n=2$, hence -|crossing_point| does not take much time. At each stage in the -recursion we have a subinterval defined by |l| and~|j| such that -$B(a,b,c;2^{-l}(j+t))=B(x_0,x_1,x_2;t)$, and we want to ``zero in'' on -the subinterval where $x_0\G0$ and $\min(x_1,x_2)<0$. - -It is convenient for purposes of calculation to combine the values -of |l| and~|j| in a single variable $d=2^l+j$, because the operation -of bisection then corresponds simply to doubling $d$ and possibly -adding~1. Furthermore it proves to be convenient to modify -our previous conventions for bisection slightly, maintaining the -variables $X_0=2^lx_0$, $X_1=2^l(x_0-x_1)$, and $X_2=2^l(x_1-x_2)$. -With these variables the conditions $x_0\ge0$ and $\min(x_1,x_2)<0$ are -equivalent to $\max(X_1,X_1+X_2)>X_0\ge0$. - -The following code maintains the invariant relations -$0\L|x0|<\max(|x1|,|x1|+|x2|)$, -$\vert|x1|\vert<2^{30}$, $\vert|x2|\vert<2^{30}$; -it has been constructed in such a way that no arithmetic overflow -will occur if the inputs satisfy -$a<2^{30}$, $\vert a-b\vert<2^{30}$, and $\vert b-c\vert<2^{30}$. - -@<Use bisection to find the crossing point...@>= -d=1; x0=a; x1=a-b; x2=b-c; -do { - x=half(x1+x2); - if ( x1-x0>x0 ) { - x2=x; x0+=x0; d+=d; - } else { - xx=x1+x-x0; - if ( xx>x0 ) { - x2=x; x0+=x0; d+=d; - } else { - x0=x0-xx; - if ( x<=x0 ) { if ( x+x2<=x0 ) no_crossing; } - x1=x; d=d+d+1; - } - } -} while (d<fraction_one); -return (d-fraction_one) - -@ Here is a routine that computes the $x$ or $y$ coordinate of the point on -a cubic corresponding to the |fraction| value~|t|. - -It is convenient to define a \.{WEB} macro |t_of_the_way| such that -|t_of_the_way(a,b)| expands to |a-(a-b)*t|, i.e., to |t[a,b]|. - -@d t_of_the_way(A,B) ((A)-mp_take_fraction(mp,((A)-(B)),t)) - -@c static scaled mp_eval_cubic (MP mp,pointer p, pointer q, fraction t) { - scaled x1,x2,x3; /* intermediate values */ - x1=t_of_the_way(knot_coord(p),right_coord(p)); - x2=t_of_the_way(right_coord(p),left_coord(q)); - x3=t_of_the_way(left_coord(q),knot_coord(q)); - x1=t_of_the_way(x1,x2); - x2=t_of_the_way(x2,x3); - return t_of_the_way(x1,x2); -} - -@ The actual bounding box information is stored in global variables. -Since it is convenient to address the $x$ and $y$ information -separately, we define arrays indexed by |x_code..y_code| and use -macros to give them more convenient names. - -@<Types...@>= -enum mp_bb_code { - mp_x_code=0, /* index for |minx| and |maxx| */ - mp_y_code /* index for |miny| and |maxy| */ -} ; - -@ -@d mp_minx mp->bbmin[mp_x_code] -@d mp_maxx mp->bbmax[mp_x_code] -@d mp_miny mp->bbmin[mp_y_code] -@d mp_maxy mp->bbmax[mp_y_code] - -@<Glob...@>= -scaled bbmin[mp_y_code+1]; -scaled bbmax[mp_y_code+1]; -/* the result of procedures that compute bounding box information */ - -@ Now we're ready for the key part of the bounding box computation. -The |bound_cubic| procedure updates |bbmin[c]| and |bbmax[c]| based on -$$B(\hbox{|knot_coord(p)|}, \hbox{|right_coord(p)|}, - \hbox{|left_coord(q)|}, \hbox{|knot_coord(q)|};t) -$$ -for $0<t\le1$. In other words, the procedure adjusts the bounds to -accommodate |knot_coord(q)| and any extremes over the range $0<t<1$. -The |c| parameter is |x_code| or |y_code|. - -@c static void mp_bound_cubic (MP mp,pointer p, pointer q, quarterword c) { - boolean wavy; /* whether we need to look for extremes */ - scaled del1,del2,del3,del,dmax; /* proportional to the control - points of a quadratic derived from a cubic */ - fraction t,tt; /* where a quadratic crosses zero */ - scaled x; /* a value that |bbmin[c]| and |bbmax[c]| must accommodate */ - x=knot_coord(q); - @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>; - @<Check the control points against the bounding box and set |wavy:=true| - if any of them lie outside@>; - if ( wavy ) { - del1=right_coord(p)-knot_coord(p); - del2=left_coord(q)-right_coord(p); - del3=knot_coord(q)-left_coord(q); - @<Scale up |del1|, |del2|, and |del3| for greater accuracy; - also set |del| to the first nonzero element of |(del1,del2,del3)|@>; - if ( del<0 ) { - negate(del1); negate(del2); negate(del3); - }; - t=mp_crossing_point(mp, del1,del2,del3); - if ( t<fraction_one ) { - @<Test the extremes of the cubic against the bounding box@>; - } - } -} - -@ @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>= -if ( x<mp->bbmin[c] ) mp->bbmin[c]=x; -if ( x>mp->bbmax[c] ) mp->bbmax[c]=x - -@ @<Check the control points against the bounding box and set...@>= -wavy=true; -if ( mp->bbmin[c]<=right_coord(p) ) - if ( right_coord(p)<=mp->bbmax[c] ) - if ( mp->bbmin[c]<=left_coord(q) ) - if ( left_coord(q)<=mp->bbmax[c] ) - wavy=false - -@ If |del1=del2=del3=0|, it's impossible to obey the title of this -section. We just set |del=0| in that case. - -@<Scale up |del1|, |del2|, and |del3| for greater accuracy...@>= -if ( del1!=0 ) del=del1; -else if ( del2!=0 ) del=del2; -else del=del3; -if ( del!=0 ) { - dmax=abs(del1); - if ( abs(del2)>dmax ) dmax=abs(del2); - if ( abs(del3)>dmax ) dmax=abs(del3); - while ( dmax<fraction_half ) { - dmax+=dmax; del1+=del1; del2+=del2; del3+=del3; - } -} - -@ Since |crossing_point| has tried to choose |t| so that -$B(|del1|,|del2|,|del3|;\tau)$ crosses zero at $\tau=|t|$ with negative -slope, the value of |del2| computed below should not be positive. -But rounding error could make it slightly positive in which case we -must cut it to zero to avoid confusion. - -@<Test the extremes of the cubic against the bounding box@>= -{ - x=mp_eval_cubic(mp, p,q,t); - @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>; - del2=t_of_the_way(del2,del3); - /* now |0,del2,del3| represent the derivative on the remaining interval */ - if ( del2>0 ) del2=0; - tt=mp_crossing_point(mp, 0,-del2,-del3); - if ( tt<fraction_one ) { - @<Test the second extreme against the bounding box@>; - } -} - -@ @<Test the second extreme against the bounding box@>= -{ - x=mp_eval_cubic(mp, p,q,t_of_the_way(tt,fraction_one)); - @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>; -} - -@ Finding the bounding box of a path is basically a matter of applying -|bound_cubic| twice for each pair of adjacent knots. - -@c static void mp_path_bbox (MP mp,pointer h) { - pointer p,q; /* a pair of adjacent knots */ - mp_minx=mp_x_coord(h); mp_miny=mp_y_coord(h); - mp_maxx=mp_minx; mp_maxy=mp_miny; - p=h; - do { - if ( mp_right_type(p)==mp_endpoint ) return; - q=mp_link(p); - mp_bound_cubic(mp, x_loc(p),x_loc(q),mp_x_code); - mp_bound_cubic(mp, y_loc(p),y_loc(q),mp_y_code); - p=q; - } while (p!=h); -} - -@ Another important way to measure a path is to find its arc length. This -is best done by using the general bisection algorithm to subdivide the path -until obtaining ``well behaved'' subpaths whose arc lengths can be approximated -by simple means. - -Since the arc length is the integral with respect to time of the magnitude of -the velocity, it is natural to use Simpson's rule for the approximation. -@^Simpson's rule@> -If $\dot B(t)$ is the spline velocity, Simpson's rule gives -$$ \vb\dot B(0)\vb + 4\vb\dot B({1\over2})\vb + \vb\dot B(1)\vb \over 6 $$ -for the arc length of a path of length~1. For a cubic spline -$B(z_0,z_1,z_2,z_3;t)$, the time derivative $\dot B(t)$ is -$3B(dz_0,dz_1,dz_2;t)$, where $dz_i=z_{i+1}-z_i$. Hence the arc length -approximation is -$$ {\vb dz_0\vb \over 2} + 2\vb dz_{02}\vb + {\vb dz_2\vb \over 2}, $$ -where -$$ dz_{02}={1\over2}\left({dz_0+dz_1\over 2}+{dz_1+dz_2\over 2}\right)$$ -is the result of the bisection algorithm. - -@ The remaining problem is how to decide when a subpath is ``well behaved.'' -This could be done via the theoretical error bound for Simpson's rule, -@^Simpson's rule@> -but this is impractical because it requires an estimate of the fourth -derivative of the quantity being integrated. It is much easier to just perform -a bisection step and see how much the arc length estimate changes. Since the -error for Simpson's rule is proportional to the fourth power of the sample -spacing, the remaining error is typically about $1\over16$ of the amount of -the change. We say ``typically'' because the error has a pseudo-random behavior -that could cause the two estimates to agree when each contain large errors. - -To protect against disasters such as undetected cusps, the bisection process -should always continue until all the $dz_i$ vectors belong to a single -$90^\circ$ sector. This ensures that no point on the spline can have velocity -less than 70\% of the minimum of $\vb dz_0\vb$, $\vb dz_1\vb$ and $\vb dz_2\vb$. -If such a spline happens to produce an erroneous arc length estimate that -is little changed by bisection, the amount of the error is likely to be fairly -small. We will try to arrange things so that freak accidents of this type do -not destroy the inverse relationship between the \&{arclength} and -\&{arctime} operations. -@:arclength_}{\&{arclength} primitive@> -@:arctime_}{\&{arctime} primitive@> - -@ The \&{arclength} and \&{arctime} operations are both based on a recursive -@^recursion@> -function that finds the arc length of a cubic spline given $dz_0$, $dz_1$, -$dz_2$. This |arc_test| routine also takes an arc length goal |a_goal| and -returns the time when the arc length reaches |a_goal| if there is such a time. -Thus the return value is either an arc length less than |a_goal| or, if the -arc length would be at least |a_goal|, it returns a time value decreased by -|two|. This allows the caller to use the sign of the result to distinguish -between arc lengths and time values. On certain types of overflow, it is -possible for |a_goal| and the result of |arc_test| both to be |el_gordo|. -Otherwise, the result is always less than |a_goal|. - -Rather than halving the control point coordinates on each recursive call to -|arc_test|, it is better to keep them proportional to velocity on the original -curve and halve the results instead. This means that recursive calls can -potentially use larger error tolerances in their arc length estimates. How -much larger depends on to what extent the errors behave as though they are -independent of each other. To save computing time, we use optimistic assumptions -and increase the tolerance by a factor of about $\sqrt2$ for each recursive -call. - -In addition to the tolerance parameter, |arc_test| should also have parameters -for ${1\over3}\vb\dot B(0)\vb$, ${2\over3}\vb\dot B({1\over2})\vb$, and -${1\over3}\vb\dot B(1)\vb$. These quantities are relatively expensive to compute -and they are needed in different instances of |arc_test|. - -@c -static scaled mp_arc_test (MP mp, scaled dx0, scaled dy0, scaled dx1, scaled dy1, - scaled dx2, scaled dy2, scaled v0, scaled v02, - scaled v2, scaled a_goal, scaled tol) { - boolean simple; /* are the control points confined to a $90^\circ$ sector? */ - scaled dx01, dy01, dx12, dy12, dx02, dy02; /* bisection results */ - scaled v002, v022; - /* twice the velocity magnitudes at $t={1\over4}$ and $t={3\over4}$ */ - scaled arc; /* best arc length estimate before recursion */ - @<Other local variables in |arc_test|@>; - @<Bisect the B\'ezier quadratic given by |dx0|, |dy0|, |dx1|, |dy1|, - |dx2|, |dy2|@>; - @<Initialize |v002|, |v022|, and the arc length estimate |arc|; if it overflows - set |arc_test| and |return|@>; - @<Test if the control points are confined to one quadrant or rotating them - $45^\circ$ would put them in one quadrant. Then set |simple| appropriately@>; - if ( simple && (abs(arc-v02-halfp(v0+v2)) <= tol) ) { - if ( arc < a_goal ) { - return arc; - } else { - @<Estimate when the arc length reaches |a_goal| and set |arc_test| to - that time minus |two|@>; - } - } else { - @<Use one or two recursive calls to compute the |arc_test| function@>; - } -} - -@ The |tol| value should by multiplied by $\sqrt 2$ before making recursive -calls, but $1.5$ is an adequate approximation. It is best to avoid using -|make_fraction| in this inner loop. -@^inner loop@> - -@<Use one or two recursive calls to compute the |arc_test| function@>= -{ - @<Set |a_new| and |a_aux| so their sum is |2*a_goal| and |a_new| is as - large as possible@>; - tol = tol + halfp(tol); - a = mp_arc_test(mp, dx0,dy0, dx01,dy01, dx02,dy02, v0, v002, - halfp(v02), a_new, tol); - if ( a<0 ) { - return (-halfp(two-a)); - } else { - @<Update |a_new| to reduce |a_new+a_aux| by |a|@>; - b = mp_arc_test(mp, dx02,dy02, dx12,dy12, dx2,dy2, - halfp(v02), v022, v2, a_new, tol); - if ( b<0 ) - return (-halfp(-b) - half_unit); - else - return (a + half(b-a)); - } -} - -@ @<Other local variables in |arc_test|@>= -scaled a,b; /* results of recursive calls */ -scaled a_new,a_aux; /* the sum of these gives the |a_goal| */ - -@ @<Set |a_new| and |a_aux| so their sum is |2*a_goal| and |a_new| is...@>= -a_aux = el_gordo - a_goal; -if ( a_goal > a_aux ) { - a_aux = a_goal - a_aux; - a_new = el_gordo; -} else { - a_new = a_goal + a_goal; - a_aux = 0; -} - -@ There is no need to maintain |a_aux| at this point so we use it as a temporary -to force the additions and subtractions to be done in an order that avoids -overflow. - -@<Update |a_new| to reduce |a_new+a_aux| by |a|@>= -if ( a > a_aux ) { - a_aux = a_aux - a; - a_new = a_new + a_aux; -} - -@ This code assumes all {\it dx} and {\it dy} variables have magnitude less than -|fraction_four|. To simplify the rest of the |arc_test| routine, we strengthen -this assumption by requiring the norm of each $({\it dx},{\it dy})$ pair to obey -this bound. Note that recursive calls will maintain this invariant. - -@<Bisect the B\'ezier quadratic given by |dx0|, |dy0|, |dx1|, |dy1|,...@>= -dx01 = half(dx0 + dx1); -dx12 = half(dx1 + dx2); -dx02 = half(dx01 + dx12); -dy01 = half(dy0 + dy1); -dy12 = half(dy1 + dy2); -dy02 = half(dy01 + dy12) - -@ We should be careful to keep |arc<el_gordo| so that calling |arc_test| with -|a_goal=el_gordo| is guaranteed to yield the arc length. - -@<Initialize |v002|, |v022|, and the arc length estimate |arc|;...@>= -v002 = mp_pyth_add(mp, dx01+half(dx0+dx02), dy01+half(dy0+dy02)); -v022 = mp_pyth_add(mp, dx12+half(dx02+dx2), dy12+half(dy02+dy2)); -tmp = halfp(v02+2); -arc1 = v002 + half(halfp(v0+tmp) - v002); -arc = v022 + half(halfp(v2+tmp) - v022); -if ( (arc < el_gordo-arc1) ) { - arc = arc+arc1; -} else { - mp->arith_error = true; - if ( a_goal==el_gordo ) return (el_gordo); - else return (-two); -} - -@ @<Other local variables in |arc_test|@>= -scaled tmp, tmp2; /* all purpose temporary registers */ -scaled arc1; /* arc length estimate for the first half */ - -@ @<Test if the control points are confined to one quadrant or rotating...@>= -simple = ((dx0>=0) && (dx1>=0) && (dx2>=0)) || - ((dx0<=0) && (dx1<=0) && (dx2<=0)); -if ( simple ) - simple = ((dy0>=0) && (dy1>=0) && (dy2>=0)) || - ((dy0<=0) && (dy1<=0) && (dy2<=0)); -if ( ! simple ) { - simple = ((dx0>=dy0) && (dx1>=dy1) && (dx2>=dy2)) || - ((dx0<=dy0) && (dx1<=dy1) && (dx2<=dy2)); - if ( simple ) - simple = ((-dx0>=dy0) && (-dx1>=dy1) && (-dx2>=dy2)) || - ((-dx0<=dy0) && (-dx1<=dy1) && (-dx2<=dy2)); -} - -@ Since Simpson's rule is based on approximating the integrand by a parabola, -@^Simpson's rule@> -it is appropriate to use the same approximation to decide when the integral -reaches the intermediate value |a_goal|. At this point -$$\eqalign{ - {\vb\dot B(0)\vb\over 3} &= \hbox{|v0|}, \qquad - {\vb\dot B({1\over4})\vb\over 3} = {\hbox{|v002|}\over 2}, \qquad - {\vb\dot B({1\over2})\vb\over 3} = {\hbox{|v02|}\over 2}, \cr - {\vb\dot B({3\over4})\vb\over 3} &= {\hbox{|v022|}\over 2}, \qquad - {\vb\dot B(1)\vb\over 3} = \hbox{|v2|} \cr -} -$$ -and -$$ {\vb\dot B(t)\vb\over 3} \approx - \cases{B\left(\hbox{|v0|}, - \hbox{|v002|}-{1\over 2}\hbox{|v0|}-{1\over 4}\hbox{|v02|}, - {1\over 2}\hbox{|v02|}; 2t \right)& - if $t\le{1\over 2}$\cr - B\left({1\over 2}\hbox{|v02|}, - \hbox{|v022|}-{1\over 4}\hbox{|v02|}-{1\over 2}\hbox{|v2|}, - \hbox{|v2|}; 2t-1 \right)& - if $t\ge{1\over 2}$.\cr} - \eqno (*) -$$ -We can integrate $\vb\dot B(t)\vb$ by using -$$\int 3B(a,b,c;\tau)\,dt = - {B(0,a,a+b,a+b+c;\tau) + {\rm constant} \over {d\tau\over dt}}. -$$ - -This construction allows us to find the time when the arc length reaches -|a_goal| by solving a cubic equation of the form -$$ B(0,a,a+b,a+b+c;\tau) = x, $$ -where $\tau$ is $2t$ or $2t+1$, $x$ is |a_goal| or |a_goal-arc1|, and $a$, $b$, -and $c$ are the Bernshte{\u\i}n coefficients from $(*)$ divided by -@^Bernshte{\u\i}n, Serge{\u\i} Natanovich@> -$d\tau\over dt$. We shall define a function |solve_rising_cubic| that finds -$\tau$ given $a$, $b$, $c$, and $x$. - -@<Estimate when the arc length reaches |a_goal| and set |arc_test| to...@>= -{ - tmp = (v02 + 2) / 4; - if ( a_goal<=arc1 ) { - tmp2 = halfp(v0); - return - (halfp(mp_solve_rising_cubic(mp, tmp2, arc1-tmp2-tmp, tmp, a_goal))- two); - } else { - tmp2 = halfp(v2); - return ((half_unit - two) + - halfp(mp_solve_rising_cubic(mp, tmp, arc-arc1-tmp-tmp2, tmp2, a_goal-arc1))); - } -} - -@ Here is the |solve_rising_cubic| routine that finds the time~$t$ when -$$ B(0, a, a+b, a+b+c; t) = x. $$ -This routine is based on |crossing_point| but is simplified by the -assumptions that $B(a,b,c;t)\ge0$ for $0\le t\le1$ and that |0<=x<=a+b+c|. -If rounding error causes this condition to be violated slightly, we just ignore -it and proceed with binary search. This finds a time when the function value -reaches |x| and the slope is positive. - -@<Declarations@>= -static scaled mp_solve_rising_cubic (MP mp,scaled a, scaled b, scaled c, scaled x) ; - -@ @c -scaled mp_solve_rising_cubic (MP mp,scaled a, scaled b, scaled c, scaled x) { - scaled ab, bc, ac; /* bisection results */ - integer t; /* $2^k+q$ where unscaled answer is in $[q2^{-k},(q+1)2^{-k})$ */ - integer xx; /* temporary for updating |x| */ - if ( (a<0) || (c<0) ) mp_confusion(mp, "rising?"); -@:this can't happen rising?}{\quad rising?@> - if ( x<=0 ) { - return 0; - } else if ( x >= a+b+c ) { - return unity; - } else { - t = 1; - @<Rescale if necessary to make sure |a|, |b|, and |c| are all less than - |el_gordo div 3|@>; - do { - t+=t; - @<Subdivide the B\'ezier quadratic defined by |a|, |b|, |c|@>; - xx = x - a - ab - ac; - if ( xx < -x ) { x+=x; b=ab; c=ac; } - else { x = x + xx; a=ac; b=bc; t = t+1; }; - } while (t < unity); - return (t - unity); - } -} - -@ @<Subdivide the B\'ezier quadratic defined by |a|, |b|, |c|@>= -ab = half(a+b); -bc = half(b+c); -ac = half(ab+bc) - -@ @d one_third_el_gordo 05252525252 /* upper bound on |a|, |b|, and |c| */ - -@<Rescale if necessary to make sure |a|, |b|, and |c| are all less than...@>= -while ((a>one_third_el_gordo)||(b>one_third_el_gordo)||(c>one_third_el_gordo)) { - a = halfp(a); - b = half(b); - c = halfp(c); - x = halfp(x); -} - -@ It is convenient to have a simpler interface to |arc_test| that requires no -unnecessary arguments and ensures that each $({\it dx},{\it dy})$ pair has -length less than |fraction_four|. - -@d arc_tol 16 /* quit when change in arc length estimate reaches this */ - -@c static scaled mp_do_arc_test (MP mp,scaled dx0, scaled dy0, scaled dx1, - scaled dy1, scaled dx2, scaled dy2, scaled a_goal) { - scaled v0,v1,v2; /* length of each $({\it dx},{\it dy})$ pair */ - scaled v02; /* twice the norm of the quadratic at $t={1\over2}$ */ - v0 = mp_pyth_add(mp, dx0,dy0); - v1 = mp_pyth_add(mp, dx1,dy1); - v2 = mp_pyth_add(mp, dx2,dy2); - if ( (v0>=fraction_four) || (v1>=fraction_four) || (v2>=fraction_four) ) { - mp->arith_error = true; - if ( a_goal==el_gordo ) return el_gordo; - else return (-two); - } else { - v02 = mp_pyth_add(mp, dx1+half(dx0+dx2), dy1+half(dy0+dy2)); - return (mp_arc_test(mp, dx0,dy0, dx1,dy1, dx2,dy2, - v0, v02, v2, a_goal, arc_tol)); - } -} - -@ Now it is easy to find the arc length of an entire path. - -@c static scaled mp_get_arc_length (MP mp,pointer h) { - pointer p,q; /* for traversing the path */ - scaled a,a_tot; /* current and total arc lengths */ - a_tot = 0; - p = h; - while ( mp_right_type(p)!=mp_endpoint ){ - q = mp_link(p); - a = mp_do_arc_test(mp, mp_right_x(p)-mp_x_coord(p), mp_right_y(p)-mp_y_coord(p), - mp_left_x(q)-mp_right_x(p), mp_left_y(q)-mp_right_y(p), - mp_x_coord(q)-mp_left_x(q), mp_y_coord(q)-mp_left_y(q), el_gordo); - a_tot = mp_slow_add(mp, a, a_tot); - if ( q==h ) break; else p=q; - } - check_arith; - return a_tot; -} - -@ The inverse operation of finding the time on a path~|h| when the arc length -reaches some value |arc0| can also be accomplished via |do_arc_test|. Some care -is required to handle very large times or negative times on cyclic paths. For -non-cyclic paths, |arc0| values that are negative or too large cause -|get_arc_time| to return 0 or the length of path~|h|. - -If |arc0| is greater than the arc length of a cyclic path~|h|, the result is a -time value greater than the length of the path. Since it could be much greater, -we must be prepared to compute the arc length of path~|h| and divide this into -|arc0| to find how many multiples of the length of path~|h| to add. - -@c static scaled mp_get_arc_time (MP mp,pointer h, scaled arc0) { - pointer p,q; /* for traversing the path */ - scaled t_tot; /* accumulator for the result */ - scaled t; /* the result of |do_arc_test| */ - scaled arc; /* portion of |arc0| not used up so far */ - integer n; /* number of extra times to go around the cycle */ - if ( arc0<0 ) { - @<Deal with a negative |arc0| value and |return|@>; - } - if ( arc0==el_gordo ) decr(arc0); - t_tot = 0; - arc = arc0; - p = h; - while ( (mp_right_type(p)!=mp_endpoint) && (arc>0) ) { - q = mp_link(p); - t = mp_do_arc_test(mp, mp_right_x(p)-mp_x_coord(p), mp_right_y(p)-mp_y_coord(p), - mp_left_x(q)-mp_right_x(p), mp_left_y(q)-mp_right_y(p), - mp_x_coord(q)-mp_left_x(q), mp_y_coord(q)-mp_left_y(q), arc); - @<Update |arc| and |t_tot| after |do_arc_test| has just returned |t|@>; - if ( q==h ) { - @<Update |t_tot| and |arc| to avoid going around the cyclic - path too many times but set |arith_error:=true| and |goto done| on - overflow@>; - } - p = q; - } - check_arith; - return t_tot; -} - -@ @<Update |arc| and |t_tot| after |do_arc_test| has just returned |t|@>= -if ( t<0 ) { t_tot = t_tot + t + two; arc = 0; } -else { t_tot = t_tot + unity; arc = arc - t; } - -@ @<Deal with a negative |arc0| value and |return|@>= -{ - if ( mp_left_type(h)==mp_endpoint ) { - t_tot=0; - } else { - p = mp_htap_ypoc(mp, h); - t_tot = -mp_get_arc_time(mp, p, -arc0); - mp_toss_knot_list(mp, p); - } - check_arith; - return t_tot; -} - -@ @<Update |t_tot| and |arc| to avoid going around the cyclic...@>= -if ( arc>0 ) { - n = arc / (arc0 - arc); - arc = arc - n*(arc0 - arc); - if ( t_tot > (el_gordo / (n+1)) ) { - return el_gordo; - } - t_tot = (n + 1)*t_tot; -} - -@* \[20] Data structures for pens. -A Pen in \MP\ can be either elliptical or polygonal. Elliptical pens result -in \ps\ \&{stroke} commands, while anything drawn with a polygonal pen is -@:stroke}{\&{stroke} command@> -converted into an area fill as described in the next part of this program. -The mathematics behind this process is based on simple aspects of the theory -of tracings developed by Leo Guibas, Lyle Ramshaw, and Jorge Stolfi -[``A kinematic framework for computational geometry,'' Proc.\ IEEE Symp.\ -Foundations of Computer Science {\bf 24} (1983), 100--111]. - -Polygonal pens are created from paths via \MP's \&{makepen} primitive. -@:makepen_}{\&{makepen} primitive@> -This path representation is almost sufficient for our purposes except that -a pen path should always be a convex polygon with the vertices in -counter-clockwise order. -Since we will need to scan pen polygons both forward and backward, a pen -should be represented as a doubly linked ring of knot nodes. There is -room for the extra back pointer because we do not need the -|mp_left_type| or |mp_right_type| fields. In fact, we don't need the |mp_left_x|, -|mp_left_y|, |mp_right_x|, or |mp_right_y| fields either but we leave these alone -so that certain procedures can operate on both pens and paths. In particular, -pens can be copied using |copy_path| and recycled using |toss_knot_list|. - -@d knil mp_info - /* this replaces the |mp_left_type| and |mp_right_type| fields in a pen knot */ - -@ The |make_pen| procedure turns a path into a pen by initializing -the |knil| pointers and making sure the knots form a convex polygon. -Thus each cubic in the given path becomes a straight line and the control -points are ignored. If the path is not cyclic, the ends are connected by a -straight line. - -@d copy_pen(A) mp_make_pen(mp, mp_copy_path(mp, (A)),false) - -@c -static pointer mp_make_pen (MP mp,pointer h, boolean need_hull) { - pointer p,q; /* two consecutive knots */ - q=h; - do { - p=q; q=mp_link(q); - knil(q)=p; - } while (q!=h); - if ( need_hull ){ - h=mp_convex_hull(mp, h); - @<Make sure |h| isn't confused with an elliptical pen@>; - } - return h; -} - -@ The only information required about an elliptical pen is the overall -transformation that has been applied to the original \&{pencircle}. -@:pencircle_}{\&{pencircle} primitive@> -Since it suffices to keep track of how the three points $(0,0)$, $(1,0)$, -and $(0,1)$ are transformed, an elliptical pen can be stored in a single -knot node and transformed as if it were a path. - -@d pen_is_elliptical(A) ((A)==mp_link((A))) - -@c -static pointer mp_get_pen_circle (MP mp,scaled diam) { - pointer h; /* the knot node to return */ - h=mp_get_node(mp, knot_node_size); - mp_link(h)=h; knil(h)=h; - mp_originator(h)=mp_program_code; - mp_x_coord(h)=0; mp_y_coord(h)=0; - mp_left_x(h)=diam; mp_left_y(h)=0; - mp_right_x(h)=0; mp_right_y(h)=diam; - return h; -} - -@ If the polygon being returned by |make_pen| has only one vertex, it will -be interpreted as an elliptical pen. This is no problem since a degenerate -polygon can equally well be thought of as a degenerate ellipse. We need only -initialize the |mp_left_x|, |mp_left_y|, |mp_right_x|, and |mp_right_y| fields. - -@<Make sure |h| isn't confused with an elliptical pen@>= -if ( pen_is_elliptical( h) ){ - mp_left_x(h)=mp_x_coord(h); mp_left_y(h)=mp_y_coord(h); - mp_right_x(h)=mp_x_coord(h); mp_right_y(h)=mp_y_coord(h); -} - -@ Printing a polygonal pen is very much like printing a path - -@<Declarations@>= -static void mp_pr_pen (MP mp,pointer h) ; - -@ @c -void mp_pr_pen (MP mp,pointer h) { - pointer p,q; /* for list traversal */ - if ( pen_is_elliptical(h) ) { - @<Print the elliptical pen |h|@>; - } else { - p=h; - do { - mp_print_two(mp, mp_x_coord(p),mp_y_coord(p)); - mp_print_nl(mp, " .. "); - @<Advance |p| making sure the links are OK and |return| if there is - a problem@>; - } while (p!=h); - mp_print(mp, "cycle"); - } -} - -@ @<Advance |p| making sure the links are OK and |return| if there is...@>= -q=mp_link(p); -if ( (q==null) || (knil(q)!=p) ) { - mp_print_nl(mp, "???"); return; /* this won't happen */ -@.???@> -} -p=q - -@ @<Print the elliptical pen |h|@>= -{ -mp_print(mp, "pencircle transformed ("); -mp_print_scaled(mp, mp_x_coord(h)); -mp_print_char(mp, xord(',')); -mp_print_scaled(mp, mp_y_coord(h)); -mp_print_char(mp, xord(',')); -mp_print_scaled(mp, mp_left_x(h)-mp_x_coord(h)); -mp_print_char(mp, xord(',')); -mp_print_scaled(mp, mp_right_x(h)-mp_x_coord(h)); -mp_print_char(mp, xord(',')); -mp_print_scaled(mp, mp_left_y(h)-mp_y_coord(h)); -mp_print_char(mp, xord(',')); -mp_print_scaled(mp, mp_right_y(h)-mp_y_coord(h)); -mp_print_char(mp, xord(')')); -} - -@ Here us another version of |pr_pen| that prints the pen as a diagnostic -message. - -@<Declarations@>= -static void mp_print_pen (MP mp,pointer h, const char *s, boolean nuline) ; - -@ @c -void mp_print_pen (MP mp,pointer h, const char *s, boolean nuline) { - mp_print_diagnostic(mp, "Pen",s,nuline); mp_print_ln(mp); -@.Pen at line...@> - mp_pr_pen(mp, h); - mp_end_diagnostic(mp, true); -} - -@ Making a polygonal pen into a path involves restoring the |mp_left_type| and -|mp_right_type| fields and setting the control points so as to make a polygonal -path. - -@c -static void mp_make_path (MP mp,pointer h) { - pointer p; /* for traversing the knot list */ - quarterword k; /* a loop counter */ - @<Other local variables in |make_path|@>; - if ( pen_is_elliptical(h) ) { - @<Make the elliptical pen |h| into a path@>; - } else { - p=h; - do { - mp_left_type(p)=mp_explicit; - mp_right_type(p)=mp_explicit; - @<copy the coordinates of knot |p| into its control points@>; - p=mp_link(p); - } while (p!=h); - } -} - -@ @<copy the coordinates of knot |p| into its control points@>= -mp_left_x(p)=mp_x_coord(p); -mp_left_y(p)=mp_y_coord(p); -mp_right_x(p)=mp_x_coord(p); -mp_right_y(p)=mp_y_coord(p) - -@ We need an eight knot path to get a good approximation to an ellipse. - -@<Make the elliptical pen |h| into a path@>= -{ - @<Extract the transformation parameters from the elliptical pen~|h|@>; - p=h; - for (k=0;k<=7;k++ ) { - @<Initialize |p| as the |k|th knot of a circle of unit diameter, - transforming it appropriately@>; - if ( k==7 ) mp_link(p)=h; else mp_link(p)=mp_get_node(mp, knot_node_size); - p=mp_link(p); - } -} - -@ @<Extract the transformation parameters from the elliptical pen~|h|@>= -center_x=mp_x_coord(h); -center_y=mp_y_coord(h); -width_x=mp_left_x(h)-center_x; -width_y=mp_left_y(h)-center_y; -height_x=mp_right_x(h)-center_x; -height_y=mp_right_y(h)-center_y - -@ @<Other local variables in |make_path|@>= -scaled center_x,center_y; /* translation parameters for an elliptical pen */ -scaled width_x,width_y; /* the effect of a unit change in $x$ */ -scaled height_x,height_y; /* the effect of a unit change in $y$ */ -scaled dx,dy; /* the vector from knot |p| to its right control point */ -integer kk; - /* |k| advanced $270^\circ$ around the ring (cf. $\sin\theta=\cos(\theta+270)$) */ - -@ The only tricky thing here are the tables |half_cos| and |d_cos| used to -find the point $k/8$ of the way around the circle and the direction vector -to use there. - -@<Initialize |p| as the |k|th knot of a circle of unit diameter,...@>= -kk=(k+6)% 8; -mp_x_coord(p)=center_x+mp_take_fraction(mp, mp->half_cos[k],width_x) - +mp_take_fraction(mp, mp->half_cos[kk],height_x); -mp_y_coord(p)=center_y+mp_take_fraction(mp, mp->half_cos[k],width_y) - +mp_take_fraction(mp, mp->half_cos[kk],height_y); -dx=-mp_take_fraction(mp, mp->d_cos[kk],width_x) - +mp_take_fraction(mp, mp->d_cos[k],height_x); -dy=-mp_take_fraction(mp, mp->d_cos[kk],width_y) - +mp_take_fraction(mp, mp->d_cos[k],height_y); -mp_right_x(p)=mp_x_coord(p)+dx; -mp_right_y(p)=mp_y_coord(p)+dy; -mp_left_x(p)=mp_x_coord(p)-dx; -mp_left_y(p)=mp_y_coord(p)-dy; -mp_left_type(p)=mp_explicit; -mp_right_type(p)=mp_explicit; -mp_originator(p)=mp_program_code - -@ @<Glob...@>= -fraction half_cos[8]; /* ${1\over2}\cos(45k)$ */ -fraction d_cos[8]; /* a magic constant times $\cos(45k)$ */ - -@ The magic constant for |d_cos| is the distance between $({1\over2},0)$ and -$({1\over4}\sqrt2,{1\over4}\sqrt2)$ times the result of the |velocity| -function for $\theta=\phi=22.5^\circ$. This comes out to be -$$ d = {\sqrt{2-\sqrt2}\over 3+3\cos22.5^\circ} - \approx 0.132608244919772. -$$ - -@<Set init...@>= -mp->half_cos[0]=fraction_half; -mp->half_cos[1]=94906266; /* $2^{26}\sqrt2\approx94906265.62$ */ -mp->half_cos[2]=0; -mp->d_cos[0]=35596755; /* $2^{28}d\approx35596754.69$ */ -mp->d_cos[1]=25170707; /* $2^{27}\sqrt2\,d\approx25170706.63$ */ -mp->d_cos[2]=0; -for (k=3;k<= 4;k++ ) { - mp->half_cos[k]=-mp->half_cos[4-k]; - mp->d_cos[k]=-mp->d_cos[4-k]; -} -for (k=5;k<= 7;k++ ) { - mp->half_cos[k]=mp->half_cos[8-k]; - mp->d_cos[k]=mp->d_cos[8-k]; -} - -@ The |convex_hull| function forces a pen polygon to be convex when it is -returned by |make_pen| and after any subsequent transformation where rounding -error might allow the convexity to be lost. -The convex hull algorithm used here is described by F.~P. Preparata and -M.~I. Shamos [{\sl Computational Geometry}, Springer-Verlag, 1985]. - -@<Declarations@>= -static pointer mp_convex_hull (MP mp,pointer h); - -@ @c -pointer mp_convex_hull (MP mp,pointer h) { /* Make a polygonal pen convex */ - pointer l,r; /* the leftmost and rightmost knots */ - pointer p,q; /* knots being scanned */ - pointer s; /* the starting point for an upcoming scan */ - scaled dx,dy; /* a temporary pointer */ - if ( pen_is_elliptical(h) ) { - return h; - } else { - @<Set |l| to the leftmost knot in polygon~|h|@>; - @<Set |r| to the rightmost knot in polygon~|h|@>; - if ( l!=r ) { - s=mp_link(r); - @<Find any knots on the path from |l| to |r| above the |l|-|r| line and - move them past~|r|@>; - @<Find any knots on the path from |s| to |l| below the |l|-|r| line and - move them past~|l|@>; - @<Sort the path from |l| to |r| by increasing $x$@>; - @<Sort the path from |r| to |l| by decreasing $x$@>; - } - if ( l!=mp_link(l) ) { - @<Do a Gramm scan and remove vertices where there is no left turn@>; - } - return l; - } -} - -@ All comparisons are done primarily on $x$ and secondarily on $y$. - -@<Set |l| to the leftmost knot in polygon~|h|@>= -l=h; -p=mp_link(h); -while ( p!=h ) { - if ( mp_x_coord(p)<=mp_x_coord(l) ) - if ( (mp_x_coord(p)<mp_x_coord(l)) || (mp_y_coord(p)<mp_y_coord(l)) ) - l=p; - p=mp_link(p); -} - -@ @<Set |r| to the rightmost knot in polygon~|h|@>= -r=h; -p=mp_link(h); -while ( p!=h ) { - if ( mp_x_coord(p)>=mp_x_coord(r) ) - if ( (mp_x_coord(p)>mp_x_coord(r)) || (mp_y_coord(p)>mp_y_coord(r)) ) - r=p; - p=mp_link(p); -} - -@ @<Find any knots on the path from |l| to |r| above the |l|-|r| line...@>= -dx=mp_x_coord(r)-mp_x_coord(l); -dy=mp_y_coord(r)-mp_y_coord(l); -p=mp_link(l); -while ( p!=r ) { - q=mp_link(p); - if ( mp_ab_vs_cd(mp, dx,mp_y_coord(p)-mp_y_coord(l),dy,mp_x_coord(p)-mp_x_coord(l))>0 ) - mp_move_knot(mp, p, r); - p=q; -} - -@ The |move_knot| procedure removes |p| from a doubly linked list and inserts -it after |q|. - -@ @<Declarations@>= -static void mp_move_knot (MP mp,pointer p, pointer q) ; - -@ @c -void mp_move_knot (MP mp,pointer p, pointer q) { - mp_link(knil(p))=mp_link(p); - knil(mp_link(p))=knil(p); - knil(p)=q; - mp_link(p)=mp_link(q); - mp_link(q)=p; - knil(mp_link(p))=p; -} - -@ @<Find any knots on the path from |s| to |l| below the |l|-|r| line...@>= -p=s; -while ( p!=l ) { - q=mp_link(p); - if ( mp_ab_vs_cd(mp, dx,mp_y_coord(p)-mp_y_coord(l),dy,mp_x_coord(p)-mp_x_coord(l))<0 ) - mp_move_knot(mp, p,l); - p=q; -} - -@ The list is likely to be in order already so we just do linear insertions. -Secondary comparisons on $y$ ensure that the sort is consistent with the -choice of |l| and |r|. - -@<Sort the path from |l| to |r| by increasing $x$@>= -p=mp_link(l); -while ( p!=r ) { - q=knil(p); - while ( mp_x_coord(q)>mp_x_coord(p) ) q=knil(q); - while ( mp_x_coord(q)==mp_x_coord(p) ) { - if ( mp_y_coord(q)>mp_y_coord(p) ) q=knil(q); else break; - } - if ( q==knil(p) ) p=mp_link(p); - else { p=mp_link(p); mp_move_knot(mp, knil(p),q); }; -} - -@ @<Sort the path from |r| to |l| by decreasing $x$@>= -p=mp_link(r); -while ( p!=l ){ - q=knil(p); - while ( mp_x_coord(q)<mp_x_coord(p) ) q=knil(q); - while ( mp_x_coord(q)==mp_x_coord(p) ) { - if ( mp_y_coord(q)<mp_y_coord(p) ) q=knil(q); else break; - } - if ( q==knil(p) ) p=mp_link(p); - else { p=mp_link(p); mp_move_knot(mp, knil(p),q); }; -} - -@ The condition involving |ab_vs_cd| tests if there is not a left turn -at knot |q|. There usually will be a left turn so we streamline the case -where the |then| clause is not executed. - -@<Do a Gramm scan and remove vertices where there...@>= -{ -p=l; q=mp_link(l); -while (1) { - dx=mp_x_coord(q)-mp_x_coord(p); - dy=mp_y_coord(q)-mp_y_coord(p); - p=q; q=mp_link(q); - if ( p==l ) break; - if ( p!=r ) - if ( mp_ab_vs_cd(mp, dx,mp_y_coord(q)-mp_y_coord(p),dy,mp_x_coord(q)-mp_x_coord(p))<=0 ) { - @<Remove knot |p| and back up |p| and |q| but don't go past |l|@>; - } - } -} - -@ @<Remove knot |p| and back up |p| and |q| but don't go past |l|@>= -{ -s=knil(p); -mp_free_node(mp, p,knot_node_size); -mp_link(s)=q; knil(q)=s; -if ( s==l ) p=s; -else { p=knil(s); q=s; }; -} - -@ The |find_offset| procedure sets global variables |(cur_x,cur_y)| to the -offset associated with the given direction |(x,y)|. If two different offsets -apply, it chooses one of them. - -@c -static void mp_find_offset (MP mp,scaled x, scaled y, pointer h) { - pointer p,q; /* consecutive knots */ - scaled wx,wy,hx,hy; - /* the transformation matrix for an elliptical pen */ - fraction xx,yy; /* untransformed offset for an elliptical pen */ - fraction d; /* a temporary register */ - if ( pen_is_elliptical(h) ) { - @<Find the offset for |(x,y)| on the elliptical pen~|h|@> - } else { - q=h; - do { - p=q; q=mp_link(q); - } while (!(mp_ab_vs_cd(mp, mp_x_coord(q)-mp_x_coord(p),y, mp_y_coord(q)-mp_y_coord(p),x)>=0)); - do { - p=q; q=mp_link(q); - } while (!(mp_ab_vs_cd(mp, mp_x_coord(q)-mp_x_coord(p),y, mp_y_coord(q)-mp_y_coord(p),x)<=0)); - mp->cur_x=mp_x_coord(p); - mp->cur_y=mp_y_coord(p); - } -} - -@ @<Glob...@>= -scaled cur_x; -scaled cur_y; /* all-purpose return value registers */ - -@ @<Find the offset for |(x,y)| on the elliptical pen~|h|@>= -if ( (x==0) && (y==0) ) { - mp->cur_x=mp_x_coord(h); mp->cur_y=mp_y_coord(h); -} else { - @<Find the non-constant part of the transformation for |h|@>; - while ( (abs(x)<fraction_half) && (abs(y)<fraction_half) ){ - x+=x; y+=y; - }; - @<Make |(xx,yy)| the offset on the untransformed \&{pencircle} for the - untransformed version of |(x,y)|@>; - mp->cur_x=mp_x_coord(h)+mp_take_fraction(mp, xx,wx)+mp_take_fraction(mp, yy,hx); - mp->cur_y=mp_y_coord(h)+mp_take_fraction(mp, xx,wy)+mp_take_fraction(mp, yy,hy); -} - -@ @<Find the non-constant part of the transformation for |h|@>= -wx=mp_left_x(h)-mp_x_coord(h); -wy=mp_left_y(h)-mp_y_coord(h); -hx=mp_right_x(h)-mp_x_coord(h); -hy=mp_right_y(h)-mp_y_coord(h) - -@ @<Make |(xx,yy)| the offset on the untransformed \&{pencircle} for the...@>= -yy=-(mp_take_fraction(mp, x,hy)+mp_take_fraction(mp, y,-hx)); -xx=mp_take_fraction(mp, x,-wy)+mp_take_fraction(mp, y,wx); -d=mp_pyth_add(mp, xx,yy); -if ( d>0 ) { - xx=half(mp_make_fraction(mp, xx,d)); - yy=half(mp_make_fraction(mp, yy,d)); -} - -@ Finding the bounding box of a pen is easy except if the pen is elliptical. -But we can handle that case by just calling |find_offset| twice. The answer -is stored in the global variables |minx|, |maxx|, |miny|, and |maxy|. - -@c -static void mp_pen_bbox (MP mp,pointer h) { - pointer p; /* for scanning the knot list */ - if ( pen_is_elliptical(h) ) { - @<Find the bounding box of an elliptical pen@>; - } else { - mp_minx=mp_x_coord(h); mp_maxx=mp_minx; - mp_miny=mp_y_coord(h); mp_maxy=mp_miny; - p=mp_link(h); - while ( p!=h ) { - if ( mp_x_coord(p)<mp_minx ) mp_minx=mp_x_coord(p); - if ( mp_y_coord(p)<mp_miny ) mp_miny=mp_y_coord(p); - if ( mp_x_coord(p)>mp_maxx ) mp_maxx=mp_x_coord(p); - if ( mp_y_coord(p)>mp_maxy ) mp_maxy=mp_y_coord(p); - p=mp_link(p); - } - } -} - -@ @<Find the bounding box of an elliptical pen@>= -{ -mp_find_offset(mp, 0,fraction_one,h); -mp_maxx=mp->cur_x; -mp_minx=2*mp_x_coord(h)-mp->cur_x; -mp_find_offset(mp, -fraction_one,0,h); -mp_maxy=mp->cur_y; -mp_miny=2*mp_y_coord(h)-mp->cur_y; -} - -@* \[21] Edge structures. -Now we come to \MP's internal scheme for representing pictures. -The representation is very different from \MF's edge structures -because \MP\ pictures contain \ps\ graphics objects instead of pixel -images. However, the basic idea is somewhat similar in that shapes -are represented via their boundaries. - -The main purpose of edge structures is to keep track of graphical objects -until it is time to translate them into \ps. Since \MP\ does not need to -know anything about an edge structure other than how to translate it into -\ps\ and how to find its bounding box, edge structures can be just linked -lists of graphical objects. \MP\ has no easy way to determine whether -two such objects overlap, but it suffices to draw the first one first and -let the second one overwrite it if necessary. - -@(mplib.h@>= -enum mp_graphical_object_code { - @<Graphical object codes@> - mp_final_graphic -}; - -@ Let's consider the types of graphical objects one at a time. -First of all, a filled contour is represented by a eight-word node. The first -word contains |type| and |link| fields, and the next six words contain a -pointer to a cyclic path and the value to use for \ps' \&{currentrgbcolor} -parameter. If a pen is used for filling |pen_p|, |ljoin_val| and |miterlim_val| -give the relevant information. - -@d mp_path_p(A) mp_link((A)+1) - /* a pointer to the path that needs filling */ -@d mp_pen_p(A) mp_info((A)+1) - /* a pointer to the pen to fill or stroke with */ -@d mp_color_model(A) mp_type((A)+2) /* the color model */ -@d obj_red_loc(A) ((A)+3) /* the first of three locations for the color */ -@d obj_cyan_loc obj_red_loc /* the first of four locations for the color */ -@d obj_grey_loc obj_red_loc /* the location for the color */ -@d red_val(A) mp->mem[(A)+3].sc - /* the red component of the color in the range $0\ldots1$ */ -@d cyan_val red_val -@d grey_val red_val -@d green_val(A) mp->mem[(A)+4].sc - /* the green component of the color in the range $0\ldots1$ */ -@d magenta_val green_val -@d blue_val(A) mp->mem[(A)+5].sc - /* the blue component of the color in the range $0\ldots1$ */ -@d yellow_val blue_val -@d black_val(A) mp->mem[(A)+6].sc - /* the blue component of the color in the range $0\ldots1$ */ -@d ljoin_val(A) mp_name_type((A)) /* the value of \&{linejoin} */ -@:mp_linejoin_}{\&{linejoin} primitive@> -@d miterlim_val(A) mp->mem[(A)+7].sc /* the value of \&{miterlimit} */ -@:mp_miterlimit_}{\&{miterlimit} primitive@> -@d obj_color_part(A) mp->mem[(A)+3-red_part].sc - /* interpret an object pointer that has been offset by |red_part..blue_part| */ -@d mp_pre_script(A) mp->mem[(A)+8].hh.lh -@d mp_post_script(A) mp->mem[(A)+8].hh.rh -@d fill_node_size 9 - -@ @<Graphical object codes@>= -mp_fill_code=1, - -@ @c -static pointer mp_new_fill_node (MP mp,pointer p) { - /* make a fill node for cyclic path |p| and color black */ - pointer t; /* the new node */ - t=mp_get_node(mp, fill_node_size); - mp_type(t)=mp_fill_code; - mp_path_p(t)=p; - mp_pen_p(t)=null; /* |null| means don't use a pen */ - red_val(t)=0; - green_val(t)=0; - blue_val(t)=0; - black_val(t)=0; - mp_color_model(t)=mp_uninitialized_model; - mp_pre_script(t)=null; - mp_post_script(t)=null; - @<Set the |ljoin_val| and |miterlim_val| fields in object |t|@>; - return t; -} - -@ @<Set the |ljoin_val| and |miterlim_val| fields in object |t|@>= -if ( mp->internal[mp_linejoin]>unity ) ljoin_val(t)=2; -else if ( mp->internal[mp_linejoin]>0 ) ljoin_val(t)=1; -else ljoin_val(t)=0; -if ( mp->internal[mp_miterlimit]<unity ) - miterlim_val(t)=unity; -else - miterlim_val(t)=mp->internal[mp_miterlimit] - -@ A stroked path is represented by an eight-word node that is like a filled -contour node except that it contains the current \&{linecap} value, a scale -factor for the dash pattern, and a pointer that is non-null if the stroke -is to be dashed. The purpose of the scale factor is to allow a picture to -be transformed without touching the picture that |dash_p| points to. - -@d mp_dash_p(A) mp_link((A)+9) - /* a pointer to the edge structure that gives the dash pattern */ -@d lcap_val(A) mp_type((A)+9) - /* the value of \&{linecap} */ -@:mp_linecap_}{\&{linecap} primitive@> -@d dash_scale(A) mp->mem[(A)+10].sc /* dash lengths are scaled by this factor */ -@d stroked_node_size 11 - -@ @<Graphical object codes@>= -mp_stroked_code=2, - -@ @c -static pointer mp_new_stroked_node (MP mp,pointer p) { - /* make a stroked node for path |p| with |mp_pen_p(p)| temporarily |null| */ - pointer t; /* the new node */ - t=mp_get_node(mp, stroked_node_size); - mp_type(t)=mp_stroked_code; - mp_path_p(t)=p; mp_pen_p(t)=null; - mp_dash_p(t)=null; - dash_scale(t)=unity; - red_val(t)=0; - green_val(t)=0; - blue_val(t)=0; - black_val(t)=0; - mp_color_model(t)=mp_uninitialized_model; - mp_pre_script(t)=null; - mp_post_script(t)=null; - @<Set the |ljoin_val| and |miterlim_val| fields in object |t|@>; - if ( mp->internal[mp_linecap]>unity ) lcap_val(t)=2; - else if ( mp->internal[mp_linecap]>0 ) lcap_val(t)=1; - else lcap_val(t)=0; - return t; -} - -@ When a dashed line is computed in a transformed coordinate system, the dash -lengths get scaled like the pen shape and we need to compensate for this. Since -there is no unique scale factor for an arbitrary transformation, we use the -the square root of the determinant. The properties of the determinant make it -easier to maintain the |dash_scale|. The computation is fairly straight-forward -except for the initialization of the scale factor |s|. The factor of 64 is -needed because |square_rt| scales its result by $2^8$ while we need $2^{14}$ -to counteract the effect of |take_fraction|. - -@ @c -scaled mp_sqrt_det (MP mp,scaled a, scaled b, scaled c, scaled d) { - scaled maxabs; /* $max(|a|,|b|,|c|,|d|)$ */ - unsigned s; /* amount by which the result of |square_rt| needs to be scaled */ - @<Initialize |maxabs|@>; - s=64; - while ( (maxabs<fraction_one) && (s>1) ){ - a+=a; b+=b; c+=c; d+=d; - maxabs+=maxabs; s=(unsigned)(halfp(s)); - } - return (scaled)(s*mp_square_rt(mp, abs(mp_take_fraction(mp, a,d)-mp_take_fraction(mp, b,c)))); -} -@# -static scaled mp_get_pen_scale (MP mp,pointer p) { - return mp_sqrt_det(mp, - mp_left_x(p)-mp_x_coord(p), mp_right_x(p)-mp_x_coord(p), - mp_left_y(p)-mp_y_coord(p), mp_right_y(p)-mp_y_coord(p)); -} - -@ @<Declarations@>= -static scaled mp_sqrt_det (MP mp,scaled a, scaled b, scaled c, scaled d) ; - - -@ @<Initialize |maxabs|@>= -maxabs=abs(a); -if ( abs(b)>maxabs ) maxabs=abs(b); -if ( abs(c)>maxabs ) maxabs=abs(c); -if ( abs(d)>maxabs ) maxabs=abs(d) - -@ When a picture contains text, this is represented by a fourteen-word node -where the color information and |type| and |link| fields are augmented by -additional fields that describe the text and how it is transformed. -The |path_p| and |mp_pen_p| pointers are replaced by a number that identifies -the font and a string number that gives the text to be displayed. -The |width|, |height|, and |depth| fields -give the dimensions of the text at its design size, and the remaining six -words give a transformation to be applied to the text. The |new_text_node| -function initializes everything to default values so that the text comes out -black with its reference point at the origin. - -@d mp_text_p(A) mp_link((A)+1) /* a string pointer for the text to display */ -@d mp_font_n(A) mp_info((A)+1) /* the font number */ -@d width_val(A) mp->mem[(A)+7].sc /* unscaled width of the text */ -@d height_val(A) mp->mem[(A)+9].sc /* unscaled height of the text */ -@d depth_val(A) mp->mem[(A)+10].sc /* unscaled depth of the text */ -@d text_tx_loc(A) ((A)+11) - /* the first of six locations for transformation parameters */ -@d tx_val(A) mp->mem[(A)+11].sc /* $x$ shift amount */ -@d ty_val(A) mp->mem[(A)+12].sc /* $y$ shift amount */ -@d txx_val(A) mp->mem[(A)+13].sc /* |txx| transformation parameter */ -@d txy_val(A) mp->mem[(A)+14].sc /* |txy| transformation parameter */ -@d tyx_val(A) mp->mem[(A)+15].sc /* |tyx| transformation parameter */ -@d tyy_val(A) mp->mem[(A)+16].sc /* |tyy| transformation parameter */ -@d text_trans_part(A) mp->mem[(A)+11-x_part].sc - /* interpret a text node pointer that has been offset by |x_part..yy_part| */ -@d text_node_size 17 - -@ @<Graphical object codes@>= -mp_text_code=3, - -@ @c -static pointer mp_new_text_node (MP mp,char *f,str_number s) { - /* make a text node for font |f| and text string |s| */ - pointer t; /* the new node */ - t=mp_get_node(mp, text_node_size); - mp_type(t)=mp_text_code; - mp_text_p(t)=s; - mp_font_n(t)=(halfword)mp_find_font(mp, f); /* this identifies the font */ - red_val(t)=0; - green_val(t)=0; - blue_val(t)=0; - black_val(t)=0; - mp_color_model(t)=mp_uninitialized_model; - mp_pre_script(t)=null; - mp_post_script(t)=null; - tx_val(t)=0; ty_val(t)=0; - txx_val(t)=unity; txy_val(t)=0; - tyx_val(t)=0; tyy_val(t)=unity; - mp_set_text_box(mp, t); /* this finds the bounding box */ - return t; -} - -@ The last two types of graphical objects that can occur in an edge structure -are clipping paths and \&{setbounds} paths. These are slightly more difficult -@:set_bounds_}{\&{setbounds} primitive@> -to implement because we must keep track of exactly what is being clipped or -bounded when pictures get merged together. For this reason, each clipping or -\&{setbounds} operation is represented by a pair of nodes: first comes a -two-word node whose |path_p| gives the relevant path, then there is the list -of objects to clip or bound followed by a two-word node whose second word is -unused. - -Using at least two words for each graphical object node allows them all to be -allocated and deallocated similarly with a global array |gr_object_size| to -give the size in words for each object type. - -@d start_clip_size 2 -@d start_bounds_size 2 -@d stop_clip_size 2 /* the second word is not used here */ -@d stop_bounds_size 2 /* the second word is not used here */ -@# -@d stop_type(A) ((A)+2) - /* matching |type| for |start_clip_code| or |start_bounds_code| */ -@d has_color(A) (mp_type((A))<mp_start_clip_code) - /* does a graphical object have color fields? */ -@d has_pen(A) (mp_type((A))<mp_text_code) - /* does a graphical object have a |mp_pen_p| field? */ -@d is_start_or_stop(A) (mp_type((A))>=mp_start_clip_code) -@d is_stop(A) (mp_type((A))>=mp_stop_clip_code) - -@ @<Graphical object codes@>= -mp_start_clip_code=4, /* |type| of a node that starts clipping */ -mp_start_bounds_code=5, /* |type| of a node that gives a \&{setbounds} path */ -mp_stop_clip_code=6, /* |type| of a node that stops clipping */ -mp_stop_bounds_code=7, /* |type| of a node that stops \&{setbounds} */ - -@ @c -static pointer mp_new_bounds_node (MP mp,pointer p, quarterword c) { - /* make a node of type |c| where |p| is the clipping or \&{setbounds} path */ - pointer t; /* the new node */ - t=mp_get_node(mp, mp->gr_object_size[c]); - mp_type(t)=c; - mp_path_p(t)=p; - return t; -} - -@ We need an array to keep track of the sizes of graphical objects. - -@<Glob...@>= -quarterword gr_object_size[mp_stop_bounds_code+1]; - -@ @<Set init...@>= -mp->gr_object_size[mp_fill_code]=fill_node_size; -mp->gr_object_size[mp_stroked_code]=stroked_node_size; -mp->gr_object_size[mp_text_code]=text_node_size; -mp->gr_object_size[mp_start_clip_code]=start_clip_size; -mp->gr_object_size[mp_stop_clip_code]=stop_clip_size; -mp->gr_object_size[mp_start_bounds_code]=start_bounds_size; -mp->gr_object_size[mp_stop_bounds_code]=stop_bounds_size; - -@ All the essential information in an edge structure is encoded as a linked list -of graphical objects as we have just seen, but it is helpful to add some -redundant information. A single edge structure might be used as a dash pattern -many times, and it would be nice to avoid scanning the same structure -repeatedly. Thus, an edge structure known to be a suitable dash pattern -has a header that gives a list of dashes in a sorted order designed for rapid -translation into \ps. - -Each dash is represented by a three-word node containing the initial and final -$x$~coordinates as well as the usual |link| field. The |link| fields points to -the dash node with the next higher $x$-coordinates and the final link points -to a special location called |null_dash|. (There should be no overlap between -dashes). Since the $y$~coordinate of the dash pattern is needed to determine -the period of repetition, this needs to be stored in the edge header along -with a pointer to the list of dash nodes. - -@d start_x(A) mp->mem[(A)+1].sc /* the starting $x$~coordinate in a dash node */ -@d stop_x(A) mp->mem[(A)+2].sc /* the ending $x$~coordinate in a dash node */ -@d dash_node_size 3 -@d dash_list mp_link - /* in an edge header this points to the first dash node */ -@d dash_y(A) mp->mem[(A)+1].sc /* $y$ value for the dash list in an edge header */ - -@ It is also convenient for an edge header to contain the bounding -box information needed by the \&{llcorner} and \&{urcorner} operators -so that this does not have to be recomputed unnecessarily. This is done by -adding fields for the $x$~and $y$ extremes as well as a pointer that indicates -how far the bounding box computation has gotten. Thus if the user asks for -the bounding box and then adds some more text to the picture before asking -for more bounding box information, the second computation need only look at -the additional text. - -When the bounding box has not been computed, the |bblast| pointer points -to a dummy link at the head of the graphical object list while the |minx_val| -and |miny_val| fields contain |el_gordo| and the |maxx_val| and |maxy_val| -fields contain |-el_gordo|. - -Since the bounding box of pictures containing objects of type -|mp_start_bounds_code| depends on the value of \&{truecorners}, the bounding box -@:mp_true_corners_}{\&{truecorners} primitive@> -data might not be valid for all values of this parameter. Hence, the |bbtype| -field is needed to keep track of this. - -@d minx_val(A) mp->mem[(A)+2].sc -@d miny_val(A) mp->mem[(A)+3].sc -@d maxx_val(A) mp->mem[(A)+4].sc -@d maxy_val(A) mp->mem[(A)+5].sc -@d bblast(A) mp_link((A)+6) /* last item considered in bounding box computation */ -@d bbtype(A) mp_info((A)+6) /* tells how bounding box data depends on \&{truecorners} */ -@d dummy_loc(A) ((A)+7) /* where the object list begins in an edge header */ -@d no_bounds 0 - /* |bbtype| value when bounding box data is valid for all \&{truecorners} values */ -@d bounds_set 1 - /* |bbtype| value when bounding box data is for \&{truecorners}${}\le 0$ */ -@d bounds_unset 2 - /* |bbtype| value when bounding box data is for \&{truecorners}${}>0$ */ - -@c -static void mp_init_bbox (MP mp,pointer h) { - /* Initialize the bounding box information in edge structure |h| */ - bblast(h)=dummy_loc(h); - bbtype(h)=no_bounds; - minx_val(h)=el_gordo; - miny_val(h)=el_gordo; - maxx_val(h)=-el_gordo; - maxy_val(h)=-el_gordo; -} - -@ The only other entries in an edge header are a reference count in the first -word and a pointer to the tail of the object list in the last word. - -@d obj_tail(A) mp_info((A)+7) /* points to the last entry in the object list */ -@d edge_header_size 8 - -@c -static void mp_init_edges (MP mp,pointer h) { - /* initialize an edge header to null values */ - dash_list(h)=null_dash; - obj_tail(h)=dummy_loc(h); - mp_link(dummy_loc(h))=null; - ref_count(h)=null; - mp_init_bbox(mp, h); -} - -@ Here is how edge structures are deleted. The process can be recursive because -of the need to dereference edge structures that are used as dash patterns. -@^recursion@> - -@d add_edge_ref(A) incr(ref_count(A)) -@d delete_edge_ref(A) { - if ( ref_count((A))==null ) - mp_toss_edges(mp, A); - else - decr(ref_count(A)); - } - -@<Declarations@>= -static void mp_flush_dash_list (MP mp,pointer h); -static pointer mp_toss_gr_object (MP mp,pointer p) ; -static void mp_toss_edges (MP mp,pointer h) ; - -@ @c void mp_toss_edges (MP mp,pointer h) { - pointer p,q; /* pointers that scan the list being recycled */ - pointer r; /* an edge structure that object |p| refers to */ - mp_flush_dash_list(mp, h); - q=mp_link(dummy_loc(h)); - while ( (q!=null) ) { - p=q; q=mp_link(q); - r=mp_toss_gr_object(mp, p); - if ( r!=null ) delete_edge_ref(r); - } - mp_free_node(mp, h,edge_header_size); -} -void mp_flush_dash_list (MP mp,pointer h) { - pointer p,q; /* pointers that scan the list being recycled */ - q=dash_list(h); - while ( q!=null_dash ) { - p=q; q=mp_link(q); - mp_free_node(mp, p,dash_node_size); - } - dash_list(h)=null_dash; -} -pointer mp_toss_gr_object (MP mp,pointer p) { - /* returns an edge structure that needs to be dereferenced */ - pointer e; /* the edge structure to return */ - e=null; - @<Prepare to recycle graphical object |p|@>; - mp_free_node(mp, p,mp->gr_object_size[mp_type(p)]); - return e; -} - -@ @<Prepare to recycle graphical object |p|@>= -switch (mp_type(p)) { -case mp_fill_code: - mp_toss_knot_list(mp, mp_path_p(p)); - if ( mp_pen_p(p)!=null ) mp_toss_knot_list(mp, mp_pen_p(p)); - if ( mp_pre_script(p)!=null ) delete_str_ref(mp_pre_script(p)); - if ( mp_post_script(p)!=null ) delete_str_ref(mp_post_script(p)); - break; -case mp_stroked_code: - mp_toss_knot_list(mp, mp_path_p(p)); - if ( mp_pen_p(p)!=null ) mp_toss_knot_list(mp, mp_pen_p(p)); - if ( mp_pre_script(p)!=null ) delete_str_ref(mp_pre_script(p)); - if ( mp_post_script(p)!=null ) delete_str_ref(mp_post_script(p)); - e=mp_dash_p(p); - break; -case mp_text_code: - delete_str_ref(mp_text_p(p)); - if ( mp_pre_script(p)!=null ) delete_str_ref(mp_pre_script(p)); - if ( mp_post_script(p)!=null ) delete_str_ref(mp_post_script(p)); - break; -case mp_start_clip_code: -case mp_start_bounds_code: - mp_toss_knot_list(mp, mp_path_p(p)); - break; -case mp_stop_clip_code: -case mp_stop_bounds_code: - break; -} /* there are no other cases */ - -@ If we use |add_edge_ref| to ``copy'' edge structures, the real copying needs -to be done before making a significant change to an edge structure. Much of -the work is done in a separate routine |copy_objects| that copies a list of -graphical objects into a new edge header. - -@c -static pointer mp_private_edges (MP mp,pointer h) { - /* make a private copy of the edge structure headed by |h| */ - pointer hh; /* the edge header for the new copy */ - pointer p,pp; /* pointers for copying the dash list */ - if ( ref_count(h)==null ) { - return h; - } else { - decr(ref_count(h)); - hh=mp_copy_objects(mp, mp_link(dummy_loc(h)),null); - @<Copy the dash list from |h| to |hh|@>; - @<Copy the bounding box information from |h| to |hh| and make |bblast(hh)| - point into the new object list@>; - return hh; - } -} - -@ Here we use the fact that |dash_list(hh)=mp_link(hh)|. -@^data structure assumptions@> - -@<Copy the dash list from |h| to |hh|@>= -pp=hh; p=dash_list(h); -while ( (p!=null_dash) ) { - mp_link(pp)=mp_get_node(mp, dash_node_size); - pp=mp_link(pp); - start_x(pp)=start_x(p); - stop_x(pp)=stop_x(p); - p=mp_link(p); -} -mp_link(pp)=null_dash; -dash_y(hh)=dash_y(h) - - -@ |h| is an edge structure - -@c -static mp_dash_object *mp_export_dashes (MP mp, pointer q, scaled *w) { - mp_dash_object *d; - pointer p, h; - scaled scf; /* scale factor */ - int *dashes = NULL; - int num_dashes = 1; - h = mp_dash_p(q); - if (h==null || dash_list(h)==null_dash) - return NULL; - p = dash_list(h); - scf=mp_get_pen_scale(mp, mp_pen_p(q)); - if (scf==0) { - if (*w==0) scf = dash_scale(q); else return NULL; - } else { - scf=mp_make_scaled(mp, *w,scf); - scf=mp_take_scaled(mp, scf,dash_scale(q)); - } - *w = scf; - d = xmalloc(1,sizeof(mp_dash_object)); - start_x(null_dash)=start_x(p)+dash_y(h); - while (p != null_dash) { - dashes = xrealloc(dashes, (num_dashes+2), sizeof(scaled)); - dashes[(num_dashes-1)] = - mp_take_scaled(mp,(stop_x(p)-start_x(p)),scf); - dashes[(num_dashes)] = - mp_take_scaled(mp,(start_x(mp_link(p))-stop_x(p)),scf); - dashes[(num_dashes+1)] = -1; /* terminus */ - num_dashes+=2; - p=mp_link(p); - } - d->array = dashes; - d->offset = mp_take_scaled(mp,mp_dash_offset(mp, h),scf); - return d; -} - - - -@ @<Copy the bounding box information from |h| to |hh|...@>= -minx_val(hh)=minx_val(h); -miny_val(hh)=miny_val(h); -maxx_val(hh)=maxx_val(h); -maxy_val(hh)=maxy_val(h); -bbtype(hh)=bbtype(h); -p=dummy_loc(h); pp=dummy_loc(hh); -while ((p!=bblast(h)) ) { - if ( p==null ) mp_confusion(mp, "bblast"); -@:this can't happen bblast}{\quad bblast@> - p=mp_link(p); pp=mp_link(pp); -} -bblast(hh)=pp - -@ Here is the promised routine for copying graphical objects into a new edge -structure. It starts copying at object~|p| and stops just before object~|q|. -If |q| is null, it copies the entire sublist headed at |p|. The resulting edge -structure requires further initialization by |init_bbox|. - -@<Declarations@>= -static pointer mp_copy_objects (MP mp, pointer p, pointer q); - -@ @c -pointer mp_copy_objects (MP mp, pointer p, pointer q) { - pointer hh; /* the new edge header */ - pointer pp; /* the last newly copied object */ - quarterword k; /* temporary register */ - hh=mp_get_node(mp, edge_header_size); - dash_list(hh)=null_dash; - ref_count(hh)=null; - pp=dummy_loc(hh); - while ( (p!=q) ) { - @<Make |mp_link(pp)| point to a copy of object |p|, and update |p| and |pp|@>; - } - obj_tail(hh)=pp; - mp_link(pp)=null; - return hh; -} - -@ @<Make |mp_link(pp)| point to a copy of object |p|, and update |p| and |pp|@>= -{ k=mp->gr_object_size[mp_type(p)]; - mp_link(pp)=mp_get_node(mp, k); - pp=mp_link(pp); - while ( (k>0) ) { decr(k); mp->mem[pp+k]=mp->mem[p+k]; }; - @<Fix anything in graphical object |pp| that should differ from the - corresponding field in |p|@>; - p=mp_link(p); -} - -@ @<Fix anything in graphical object |pp| that should differ from the...@>= -switch (mp_type(p)) { -case mp_start_clip_code: -case mp_start_bounds_code: - mp_path_p(pp)=mp_copy_path(mp, mp_path_p(p)); - break; -case mp_fill_code: - mp_path_p(pp)=mp_copy_path(mp, mp_path_p(p)); - if ( mp_pre_script(p)!=null ) add_str_ref(mp_pre_script(p)); - if ( mp_post_script(p)!=null ) add_str_ref(mp_post_script(p)); - if ( mp_pen_p(p)!=null ) mp_pen_p(pp)=copy_pen(mp_pen_p(p)); - break; -case mp_stroked_code: - if ( mp_pre_script(p)!=null ) add_str_ref(mp_pre_script(p)); - if ( mp_post_script(p)!=null ) add_str_ref(mp_post_script(p)); - mp_path_p(pp)=mp_copy_path(mp, mp_path_p(p)); - mp_pen_p(pp)=copy_pen(mp_pen_p(p)); - if ( mp_dash_p(p)!=null ) add_edge_ref(mp_dash_p(pp)); - break; -case mp_text_code: - if ( mp_pre_script(p)!=null ) add_str_ref(mp_pre_script(p)); - if ( mp_post_script(p)!=null ) add_str_ref(mp_post_script(p)); - add_str_ref(mp_text_p(pp)); - break; -case mp_stop_clip_code: -case mp_stop_bounds_code: - break; -} /* there are no other cases */ - -@ Here is one way to find an acceptable value for the second argument to -|copy_objects|. Given a non-null graphical object list, |skip_1component| -skips past one picture component, where a ``picture component'' is a single -graphical object, or a start bounds or start clip object and everything up -through the matching stop bounds or stop clip object. The macro version avoids -procedure call overhead and error handling: |skip_component(p)(e)| advances |p| -unless |p| points to a stop bounds or stop clip node, in which case it executes -|e| instead. - -@d skip_component(A) - if ( ! is_start_or_stop((A)) ) (A)=mp_link((A)); - else if ( ! is_stop((A)) ) (A)=mp_skip_1component(mp, (A)); - else - -@c -static pointer mp_skip_1component (MP mp,pointer p) { - integer lev; /* current nesting level */ - lev=0; - do { - if ( is_start_or_stop(p) ) { - if ( is_stop(p) ) decr(lev); else incr(lev); - } - p=mp_link(p); - } while (lev!=0); - return p; -} - -@ Here is a diagnostic routine for printing an edge structure in symbolic form. - -@<Declarations@>= -static void mp_print_edges (MP mp,pointer h, const char *s, boolean nuline) ; - -@ @c -void mp_print_edges (MP mp,pointer h, const char *s, boolean nuline) { - pointer p; /* a graphical object to be printed */ - pointer hh,pp; /* temporary pointers */ - scaled scf; /* a scale factor for the dash pattern */ - boolean ok_to_dash; /* |false| for polygonal pen strokes */ - mp_print_diagnostic(mp, "Edge structure",s,nuline); - p=dummy_loc(h); - while ( mp_link(p)!=null ) { - p=mp_link(p); - mp_print_ln(mp); - switch (mp_type(p)) { - @<Cases for printing graphical object node |p|@>; - default: - mp_print(mp, "[unknown object type!]"); - break; - } - } - mp_print_nl(mp, "End edges"); - if ( p!=obj_tail(h) ) mp_print(mp, "?"); -@.End edges?@> - mp_end_diagnostic(mp, true); -} - -@ @<Cases for printing graphical object node |p|@>= -case mp_fill_code: - mp_print(mp, "Filled contour "); - mp_print_obj_color(mp, p); - mp_print_char(mp, xord(':')); mp_print_ln(mp); - mp_pr_path(mp, mp_path_p(p)); mp_print_ln(mp); - if ( (mp_pen_p(p)!=null) ) { - @<Print join type for graphical object |p|@>; - mp_print(mp, " with pen"); mp_print_ln(mp); - mp_pr_pen(mp, mp_pen_p(p)); - } - break; - -@ @<Print join type for graphical object |p|@>= -switch (ljoin_val(p)) { -case 0: - mp_print(mp, "mitered joins limited "); - mp_print_scaled(mp, miterlim_val(p)); - break; -case 1: - mp_print(mp, "round joins"); - break; -case 2: - mp_print(mp, "beveled joins"); - break; -default: - mp_print(mp, "?? joins"); -@.??@> - break; -} - -@ For stroked nodes, we need to print |lcap_val(p)| as well. - -@<Print join and cap types for stroked node |p|@>= -switch (lcap_val(p)) { -case 0:mp_print(mp, "butt"); break; -case 1:mp_print(mp, "round"); break; -case 2:mp_print(mp, "square"); break; -default: mp_print(mp, "??"); break; -@.??@> -} -mp_print(mp, " ends, "); -@<Print join type for graphical object |p|@> - -@ Here is a routine that prints the color of a graphical object if it isn't -black (the default color). - -@<Declarations@>= -static void mp_print_obj_color (MP mp,pointer p) ; - -@ @c -void mp_print_obj_color (MP mp,pointer p) { - if ( mp_color_model(p)==mp_grey_model ) { - if ( grey_val(p)>0 ) { - mp_print(mp, "greyed "); - mp_print_compact_node(mp, obj_grey_loc(p),1); - }; - } else if ( mp_color_model(p)==mp_cmyk_model ) { - if ( (cyan_val(p)>0) || (magenta_val(p)>0) || - (yellow_val(p)>0) || (black_val(p)>0) ) { - mp_print(mp, "processcolored "); - mp_print_compact_node(mp, obj_cyan_loc(p),4); - }; - } else if ( mp_color_model(p)==mp_rgb_model ) { - if ( (red_val(p)>0) || (green_val(p)>0) || (blue_val(p)>0) ) { - mp_print(mp, "colored "); - mp_print_compact_node(mp, obj_red_loc(p),3); - }; - } -} - -@ We also need a procedure for printing consecutive scaled values as if they -were a known big node. - -@<Declarations@>= -static void mp_print_compact_node (MP mp,pointer p, quarterword k) ; - -@ @c -void mp_print_compact_node (MP mp,pointer p, quarterword k) { - pointer q; /* last location to print */ - q=p+k-1; - mp_print_char(mp, xord('(')); - while ( p<=q ){ - mp_print_scaled(mp, mp->mem[p].sc); - if ( p<q ) mp_print_char(mp, xord(',')); - incr(p); - } - mp_print_char(mp, xord(')')); -} - -@ @<Cases for printing graphical object node |p|@>= -case mp_stroked_code: - mp_print(mp, "Filled pen stroke "); - mp_print_obj_color(mp, p); - mp_print_char(mp, xord(':')); mp_print_ln(mp); - mp_pr_path(mp, mp_path_p(p)); - if ( mp_dash_p(p)!=null ) { - mp_print_nl(mp, "dashed ("); - @<Finish printing the dash pattern that |p| refers to@>; - } - mp_print_ln(mp); - @<Print join and cap types for stroked node |p|@>; - mp_print(mp, " with pen"); mp_print_ln(mp); - if ( mp_pen_p(p)==null ) mp_print(mp, "???"); /* shouldn't happen */ -@.???@> - else mp_pr_pen(mp, mp_pen_p(p)); - break; - -@ Normally, the |dash_list| field in an edge header is set to |null_dash| -when it is not known to define a suitable dash pattern. This is disallowed -here because the |mp_dash_p| field should never point to such an edge header. -Note that memory is allocated for |start_x(null_dash)| and we are free to -give it any convenient value. - -@<Finish printing the dash pattern that |p| refers to@>= -ok_to_dash=pen_is_elliptical(mp_pen_p(p)); -if ( ! ok_to_dash ) scf=unity; else scf=dash_scale(p); -hh=mp_dash_p(p); -pp=dash_list(hh); -if ( (pp==null_dash) || (dash_y(hh)<0) ) { - mp_print(mp, " ??"); -} else { start_x(null_dash)=start_x(pp)+dash_y(hh); - while ( pp!=null_dash ) { - mp_print(mp, "on "); - mp_print_scaled(mp, mp_take_scaled(mp, stop_x(pp)-start_x(pp),scf)); - mp_print(mp, " off "); - mp_print_scaled(mp, mp_take_scaled(mp, start_x(mp_link(pp))-stop_x(pp),scf)); - pp = mp_link(pp); - if ( pp!=null_dash ) mp_print_char(mp, xord(' ')); - } - mp_print(mp, ") shifted "); - mp_print_scaled(mp, -mp_take_scaled(mp, mp_dash_offset(mp, hh),scf)); - if ( ! ok_to_dash || (dash_y(hh)==0) ) mp_print(mp, " (this will be ignored)"); -} - -@ @<Declarations@>= -static scaled mp_dash_offset (MP mp,pointer h) ; - -@ @c -scaled mp_dash_offset (MP mp,pointer h) { - scaled x; /* the answer */ - if (dash_list(h)==null_dash || dash_y(h)<0) mp_confusion(mp, "dash0"); -@:this can't happen dash0}{\quad dash0@> - if ( dash_y(h)==0 ) { - x=0; - } else { - x=-(start_x(dash_list(h)) % dash_y(h)); - if ( x<0 ) x=x+dash_y(h); - } - return x; -} - -@ @<Cases for printing graphical object node |p|@>= -case mp_text_code: - mp_print_char(mp, xord('"')); mp_print_str(mp,mp_text_p(p)); - mp_print(mp, "\" infont \""); mp_print(mp, mp->font_name[mp_font_n(p)]); - mp_print_char(mp, xord('"')); mp_print_ln(mp); - mp_print_obj_color(mp, p); - mp_print(mp, "transformed "); - mp_print_compact_node(mp, text_tx_loc(p),6); - break; - -@ @<Cases for printing graphical object node |p|@>= -case mp_start_clip_code: - mp_print(mp, "clipping path:"); - mp_print_ln(mp); - mp_pr_path(mp, mp_path_p(p)); - break; -case mp_stop_clip_code: - mp_print(mp, "stop clipping"); - break; - -@ @<Cases for printing graphical object node |p|@>= -case mp_start_bounds_code: - mp_print(mp, "setbounds path:"); - mp_print_ln(mp); - mp_pr_path(mp, mp_path_p(p)); - break; -case mp_stop_bounds_code: - mp_print(mp, "end of setbounds"); - break; - -@ To initialize the |dash_list| field in an edge header~|h|, we need a -subroutine that scans an edge structure and tries to interpret it as a dash -pattern. This can only be done when there are no filled regions or clipping -paths and all the pen strokes have the same color. The first step is to let -$y_0$ be the initial $y$~coordinate of the first pen stroke. Then we implicitly -project all the pen stroke paths onto the line $y=y_0$ and require that there -be no retracing. If the resulting paths cover a range of $x$~coordinates of -length $\Delta x$, we set |dash_y(h)| to the length of the dash pattern by -finding the maximum of $\Delta x$ and the absolute value of~$y_0$. - -@c -static pointer mp_make_dashes (MP mp,pointer h) { /* returns |h| or |null| */ - pointer p; /* this scans the stroked nodes in the object list */ - pointer p0; /* if not |null| this points to the first stroked node */ - pointer pp,qq,rr; /* pointers into |mp_path_p(p)| */ - pointer d,dd; /* pointers used to create the dash list */ - scaled y0; - @<Other local variables in |make_dashes|@>; - y0=0; /* the initial $y$ coordinate */ - if ( dash_list(h)!=null_dash ) - return h; - p0=null; - p=mp_link(dummy_loc(h)); - while ( p!=null ) { - if ( mp_type(p)!=mp_stroked_code ) { - @<Compain that the edge structure contains a node of the wrong type - and |goto not_found|@>; - } - pp=mp_path_p(p); - if ( p0==null ){ p0=p; y0=mp_y_coord(pp); }; - @<Make |d| point to a new dash node created from stroke |p| and path |pp| - or |goto not_found| if there is an error@>; - @<Insert |d| into the dash list and |goto not_found| if there is an error@>; - p=mp_link(p); - } - if ( dash_list(h)==null_dash ) - goto NOT_FOUND; /* No error message */ - @<Scan |dash_list(h)| and deal with any dashes that are themselves dashed@>; - @<Set |dash_y(h)| and merge the first and last dashes if necessary@>; - return h; -NOT_FOUND: - @<Flush the dash list, recycle |h| and return |null|@>; -} - -@ @<Compain that the edge structure contains a node of the wrong type...@>= -{ -print_err("Picture is too complicated to use as a dash pattern"); -help3("When you say `dashed p', picture p should not contain any", - "text, filled regions, or clipping paths. This time it did", - "so I'll just make it a solid line instead."); -mp_put_get_error(mp); -goto NOT_FOUND; -} - -@ A similar error occurs when monotonicity fails. - -@<Declarations@>= -static void mp_x_retrace_error (MP mp) ; - -@ @c -void mp_x_retrace_error (MP mp) { -print_err("Picture is too complicated to use as a dash pattern"); -help3("When you say `dashed p', every path in p should be monotone", - "in x and there must be no overlapping. This failed", - "so I'll just make it a solid line instead."); -mp_put_get_error(mp); -} - -@ We stash |p| in |mp_info(d)| if |mp_dash_p(p)<>0| so that subsequent processing can -handle the case where the pen stroke |p| is itself dashed. - -@<Make |d| point to a new dash node created from stroke |p| and path...@>= -@<Make sure |p| and |p0| are the same color and |goto not_found| if there is - an error@>; -rr=pp; -if ( mp_link(pp)!=pp ) { - do { - qq=rr; rr=mp_link(rr); - @<Check for retracing between knots |qq| and |rr| and |goto not_found| - if there is a problem@>; - } while (mp_right_type(rr)!=mp_endpoint); -} -d=mp_get_node(mp, dash_node_size); -if ( mp_dash_p(p)==0 ) mp_info(d)=0; else mp_info(d)=p; -if ( mp_x_coord(pp)<mp_x_coord(rr) ) { - start_x(d)=mp_x_coord(pp); - stop_x(d)=mp_x_coord(rr); -} else { - start_x(d)=mp_x_coord(rr); - stop_x(d)=mp_x_coord(pp); -} - -@ We also need to check for the case where the segment from |qq| to |rr| is -monotone in $x$ but is reversed relative to the path from |pp| to |qq|. - -@<Check for retracing between knots |qq| and |rr| and |goto not_found|...@>= -x0=mp_x_coord(qq); -x1=mp_right_x(qq); -x2=mp_left_x(rr); -x3=mp_x_coord(rr); -if ( (x0>x1) || (x1>x2) || (x2>x3) ) { - if ( (x0<x1) || (x1<x2) || (x2<x3) ) { - if ( mp_ab_vs_cd(mp, x2-x1,x2-x1,x1-x0,x3-x2)>0 ) { - mp_x_retrace_error(mp); goto NOT_FOUND; - } - } -} -if ( (mp_x_coord(pp)>x0) || (x0>x3) ) { - if ( (mp_x_coord(pp)<x0) || (x0<x3) ) { - mp_x_retrace_error(mp); goto NOT_FOUND; - } -} - -@ @<Other local variables in |make_dashes|@>= - scaled x0,x1,x2,x3; /* $x$ coordinates of the segment from |qq| to |rr| */ - -@ @<Make sure |p| and |p0| are the same color and |goto not_found|...@>= -if ( (red_val(p)!=red_val(p0)) || (black_val(p)!=black_val(p0)) || - (green_val(p)!=green_val(p0)) || (blue_val(p)!=blue_val(p0)) ) { - print_err("Picture is too complicated to use as a dash pattern"); - help3("When you say `dashed p', everything in picture p should", - "be the same color. I can\'t handle your color changes", - "so I'll just make it a solid line instead."); - mp_put_get_error(mp); - goto NOT_FOUND; -} - -@ @<Insert |d| into the dash list and |goto not_found| if there is an error@>= -start_x(null_dash)=stop_x(d); -dd=h; /* this makes |mp_link(dd)=dash_list(h)| */ -while ( start_x(mp_link(dd))<stop_x(d) ) - dd=mp_link(dd); -if ( dd!=h ) { - if ( (stop_x(dd)>start_x(d)) ) - { mp_x_retrace_error(mp); goto NOT_FOUND; }; -} -mp_link(d)=mp_link(dd); -mp_link(dd)=d - -@ @<Set |dash_y(h)| and merge the first and last dashes if necessary@>= -d=dash_list(h); -while ( (mp_link(d)!=null_dash) ) - d=mp_link(d); -dd=dash_list(h); -dash_y(h)=stop_x(d)-start_x(dd); -if ( abs(y0)>dash_y(h) ) { - dash_y(h)=abs(y0); -} else if ( d!=dd ) { - dash_list(h)=mp_link(dd); - stop_x(d)=stop_x(dd)+dash_y(h); - mp_free_node(mp, dd,dash_node_size); -} - -@ We get here when the argument is a null picture or when there is an error. -Recovering from an error involves making |dash_list(h)| empty to indicate -that |h| is not known to be a valid dash pattern. We also dereference |h| -since it is not being used for the return value. - -@<Flush the dash list, recycle |h| and return |null|@>= -mp_flush_dash_list(mp, h); -delete_edge_ref(h); -return null - -@ Having carefully saved the dashed stroked nodes in the -corresponding dash nodes, we must be prepared to break up these dashes into -smaller dashes. - -@<Scan |dash_list(h)| and deal with any dashes that are themselves dashed@>= -d=h; /* now |mp_link(d)=dash_list(h)| */ -while ( mp_link(d)!=null_dash ) { - ds=mp_info(mp_link(d)); - if ( ds==null ) { - d=mp_link(d); - } else { - hh=mp_dash_p(ds); - hsf=dash_scale(ds); - if ( (hh==null) ) mp_confusion(mp, "dash1"); -@:this can't happen dash0}{\quad dash1@> - if ( dash_y(hh)==0 ) { - d=mp_link(d); - } else { - if ( dash_list(hh)==null ) mp_confusion(mp, "dash1"); -@:this can't happen dash0}{\quad dash1@> - @<Replace |mp_link(d)| by a dashed version as determined by edge header - |hh| and scale factor |ds|@>; - } - } -} - -@ @<Other local variables in |make_dashes|@>= -pointer dln; /* |mp_link(d)| */ -pointer hh; /* an edge header that tells how to break up |dln| */ -scaled hsf; /* the dash pattern from |hh| gets scaled by this */ -pointer ds; /* the stroked node from which |hh| and |hsf| are derived */ -scaled xoff; /* added to $x$ values in |dash_list(hh)| to match |dln| */ - -@ @<Replace |mp_link(d)| by a dashed version as determined by edge header...@>= -dln=mp_link(d); -dd=dash_list(hh); -xoff=start_x(dln)-mp_take_scaled(mp, hsf,start_x(dd))- - mp_take_scaled(mp, hsf,mp_dash_offset(mp, hh)); -start_x(null_dash)=mp_take_scaled(mp, hsf,start_x(dd)) - +mp_take_scaled(mp, hsf,dash_y(hh)); -stop_x(null_dash)=start_x(null_dash); -@<Advance |dd| until finding the first dash that overlaps |dln| when - offset by |xoff|@>; -while ( start_x(dln)<=stop_x(dln) ) { - @<If |dd| has `fallen off the end', back up to the beginning and fix |xoff|@>; - @<Insert a dash between |d| and |dln| for the overlap with the offset version - of |dd|@>; - dd=mp_link(dd); - start_x(dln)=xoff+mp_take_scaled(mp, hsf,start_x(dd)); -} -mp_link(d)=mp_link(dln); -mp_free_node(mp, dln,dash_node_size) - -@ The name of this module is a bit of a lie because we just find the -first |dd| where |take_scaled (hsf, stop_x(dd))| is large enough to make an -overlap possible. It could be that the unoffset version of dash |dln| falls -in the gap between |dd| and its predecessor. - -@<Advance |dd| until finding the first dash that overlaps |dln| when...@>= -while ( xoff+mp_take_scaled(mp, hsf,stop_x(dd))<start_x(dln) ) { - dd=mp_link(dd); -} - -@ @<If |dd| has `fallen off the end', back up to the beginning and fix...@>= -if ( dd==null_dash ) { - dd=dash_list(hh); - xoff=xoff+mp_take_scaled(mp, hsf,dash_y(hh)); -} - -@ At this point we already know that -|start_x(dln)<=xoff+take_scaled(hsf,stop_x(dd))|. - -@<Insert a dash between |d| and |dln| for the overlap with the offset...@>= -if ( (xoff+mp_take_scaled(mp, hsf,start_x(dd)))<=stop_x(dln) ) { - mp_link(d)=mp_get_node(mp, dash_node_size); - d=mp_link(d); - mp_link(d)=dln; - if ( start_x(dln)>(xoff+mp_take_scaled(mp, hsf,start_x(dd)))) - start_x(d)=start_x(dln); - else - start_x(d)=xoff+mp_take_scaled(mp, hsf,start_x(dd)); - if ( stop_x(dln)<(xoff+mp_take_scaled(mp, hsf,stop_x(dd)))) - stop_x(d)=stop_x(dln); - else - stop_x(d)=xoff+mp_take_scaled(mp, hsf,stop_x(dd)); -} - -@ The next major task is to update the bounding box information in an edge -header~|h|. This is done via a procedure |adjust_bbox| that enlarges an edge -header's bounding box to accommodate the box computed by |path_bbox| or -|pen_bbox|. (This is stored in global variables |minx|, |miny|, |maxx|, and -|maxy|.) - -@c static void mp_adjust_bbox (MP mp,pointer h) { - if ( mp_minx<minx_val(h) ) minx_val(h)=mp_minx; - if ( mp_miny<miny_val(h) ) miny_val(h)=mp_miny; - if ( mp_maxx>maxx_val(h) ) maxx_val(h)=mp_maxx; - if ( mp_maxy>maxy_val(h) ) maxy_val(h)=mp_maxy; -} - -@ Here is a special routine for updating the bounding box information in -edge header~|h| to account for the squared-off ends of a non-cyclic path~|p| -that is to be stroked with the pen~|pp|. - -@c static void mp_box_ends (MP mp, pointer p, pointer pp, pointer h) { - pointer q; /* a knot node adjacent to knot |p| */ - fraction dx,dy; /* a unit vector in the direction out of the path at~|p| */ - scaled d; /* a factor for adjusting the length of |(dx,dy)| */ - scaled z; /* a coordinate being tested against the bounding box */ - scaled xx,yy; /* the extreme pen vertex in the |(dx,dy)| direction */ - integer i; /* a loop counter */ - if ( mp_right_type(p)!=mp_endpoint ) { - q=mp_link(p); - while (1) { - @<Make |(dx,dy)| the final direction for the path segment from - |q| to~|p|; set~|d|@>; - d=mp_pyth_add(mp, dx,dy); - if ( d>0 ) { - @<Normalize the direction |(dx,dy)| and find the pen offset |(xx,yy)|@>; - for (i=1;i<= 2;i++) { - @<Use |(dx,dy)| to generate a vertex of the square end cap and - update the bounding box to accommodate it@>; - dx=-dx; dy=-dy; - } - } - if ( mp_right_type(p)==mp_endpoint ) { - return; - } else { - @<Advance |p| to the end of the path and make |q| the previous knot@>; - } - } - } -} - -@ @<Make |(dx,dy)| the final direction for the path segment from...@>= -if ( q==mp_link(p) ) { - dx=mp_x_coord(p)-mp_right_x(p); - dy=mp_y_coord(p)-mp_right_y(p); - if ( (dx==0)&&(dy==0) ) { - dx=mp_x_coord(p)-mp_left_x(q); - dy=mp_y_coord(p)-mp_left_y(q); - } -} else { - dx=mp_x_coord(p)-mp_left_x(p); - dy=mp_y_coord(p)-mp_left_y(p); - if ( (dx==0)&&(dy==0) ) { - dx=mp_x_coord(p)-mp_right_x(q); - dy=mp_y_coord(p)-mp_right_y(q); - } -} -dx=mp_x_coord(p)-mp_x_coord(q); -dy=mp_y_coord(p)-mp_y_coord(q) - -@ @<Normalize the direction |(dx,dy)| and find the pen offset |(xx,yy)|@>= -dx=mp_make_fraction(mp, dx,d); -dy=mp_make_fraction(mp, dy,d); -mp_find_offset(mp, -dy,dx,pp); -xx=mp->cur_x; yy=mp->cur_y - -@ @<Use |(dx,dy)| to generate a vertex of the square end cap and...@>= -mp_find_offset(mp, dx,dy,pp); -d=mp_take_fraction(mp, xx-mp->cur_x,dx)+mp_take_fraction(mp, yy-mp->cur_y,dy); -if ( ((d<0)&&(i==1)) || ((d>0)&&(i==2))) - mp_confusion(mp, "box_ends"); -@:this can't happen box ends}{\quad\\{box\_ends}@> -z=mp_x_coord(p)+mp->cur_x+mp_take_fraction(mp, d,dx); -if ( z<minx_val(h) ) minx_val(h)=z; -if ( z>maxx_val(h) ) maxx_val(h)=z; -z=mp_y_coord(p)+mp->cur_y+mp_take_fraction(mp, d,dy); -if ( z<miny_val(h) ) miny_val(h)=z; -if ( z>maxy_val(h) ) maxy_val(h)=z - -@ @<Advance |p| to the end of the path and make |q| the previous knot@>= -do { - q=p; - p=mp_link(p); -} while (mp_right_type(p)!=mp_endpoint) - -@ The major difficulty in finding the bounding box of an edge structure is the -effect of clipping paths. We treat them conservatively by only clipping to the -clipping path's bounding box, but this still -requires recursive calls to |set_bbox| in order to find the bounding box of -@^recursion@> -the objects to be clipped. Such calls are distinguished by the fact that the -boolean parameter |top_level| is false. - -@c -void mp_set_bbox (MP mp,pointer h, boolean top_level) { - pointer p; /* a graphical object being considered */ - scaled sminx,sminy,smaxx,smaxy; - /* for saving the bounding box during recursive calls */ - scaled x0,x1,y0,y1; /* temporary registers */ - integer lev; /* nesting level for |mp_start_bounds_code| nodes */ - @<Wipe out any existing bounding box information if |bbtype(h)| is - incompatible with |internal[mp_true_corners]|@>; - while ( mp_link(bblast(h))!=null ) { - p=mp_link(bblast(h)); - bblast(h)=p; - switch (mp_type(p)) { - case mp_stop_clip_code: - if ( top_level ) mp_confusion(mp, "bbox"); else return; -@:this can't happen bbox}{\quad bbox@> - break; - @<Other cases for updating the bounding box based on the type of object |p|@>; - } /* all cases are enumerated above */ - } - if ( ! top_level ) mp_confusion(mp, "bbox"); -} - -@ @<Declarations@>= -static void mp_set_bbox (MP mp,pointer h, boolean top_level); - -@ @<Wipe out any existing bounding box information if |bbtype(h)| is...@>= -switch (bbtype(h)) { -case no_bounds: - break; -case bounds_set: - if ( mp->internal[mp_true_corners]>0 ) mp_init_bbox(mp, h); - break; -case bounds_unset: - if ( mp->internal[mp_true_corners]<=0 ) mp_init_bbox(mp, h); - break; -} /* there are no other cases */ - -@ @<Other cases for updating the bounding box...@>= -case mp_fill_code: - mp_path_bbox(mp, mp_path_p(p)); - if ( mp_pen_p(p)!=null ) { - x0=mp_minx; y0=mp_miny; - x1=mp_maxx; y1=mp_maxy; - mp_pen_bbox(mp, mp_pen_p(p)); - mp_minx=mp_minx+x0; - mp_miny=mp_miny+y0; - mp_maxx=mp_maxx+x1; - mp_maxy=mp_maxy+y1; - } - mp_adjust_bbox(mp, h); - break; - -@ @<Other cases for updating the bounding box...@>= -case mp_start_bounds_code: - if ( mp->internal[mp_true_corners]>0 ) { - bbtype(h)=bounds_unset; - } else { - bbtype(h)=bounds_set; - mp_path_bbox(mp, mp_path_p(p)); - mp_adjust_bbox(mp, h); - @<Scan to the matching |mp_stop_bounds_code| node and update |p| and - |bblast(h)|@>; - } - break; -case mp_stop_bounds_code: - if ( mp->internal[mp_true_corners]<=0 ) mp_confusion(mp, "bbox2"); -@:this can't happen bbox2}{\quad bbox2@> - break; - -@ @<Scan to the matching |mp_stop_bounds_code| node and update |p| and...@>= -lev=1; -while ( lev!=0 ) { - if ( mp_link(p)==null ) mp_confusion(mp, "bbox2"); -@:this can't happen bbox2}{\quad bbox2@> - p=mp_link(p); - if ( mp_type(p)==mp_start_bounds_code ) incr(lev); - else if ( mp_type(p)==mp_stop_bounds_code ) decr(lev); -} -bblast(h)=p - -@ It saves a lot of grief here to be slightly conservative and not account for -omitted parts of dashed lines. We also don't worry about the material omitted -when using butt end caps. The basic computation is for round end caps and -|box_ends| augments it for square end caps. - -@<Other cases for updating the bounding box...@>= -case mp_stroked_code: - mp_path_bbox(mp, mp_path_p(p)); - x0=mp_minx; y0=mp_miny; - x1=mp_maxx; y1=mp_maxy; - mp_pen_bbox(mp, mp_pen_p(p)); - mp_minx=mp_minx+x0; - mp_miny=mp_miny+y0; - mp_maxx=mp_maxx+x1; - mp_maxy=mp_maxy+y1; - mp_adjust_bbox(mp, h); - if ( (mp_left_type(mp_path_p(p))==mp_endpoint)&&(lcap_val(p)==2) ) - mp_box_ends(mp, mp_path_p(p), mp_pen_p(p), h); - break; - -@ The height width and depth information stored in a text node determines a -rectangle that needs to be transformed according to the transformation -parameters stored in the text node. - -@<Other cases for updating the bounding box...@>= -case mp_text_code: - x1=mp_take_scaled(mp, txx_val(p),width_val(p)); - y0=mp_take_scaled(mp, txy_val(p),-depth_val(p)); - y1=mp_take_scaled(mp, txy_val(p),height_val(p)); - mp_minx=tx_val(p); - mp_maxx=mp_minx; - if ( y0<y1 ) { mp_minx=mp_minx+y0; mp_maxx=mp_maxx+y1; } - else { mp_minx=mp_minx+y1; mp_maxx=mp_maxx+y0; } - if ( x1<0 ) mp_minx=mp_minx+x1; else mp_maxx=mp_maxx+x1; - x1=mp_take_scaled(mp, tyx_val(p),width_val(p)); - y0=mp_take_scaled(mp, tyy_val(p),-depth_val(p)); - y1=mp_take_scaled(mp, tyy_val(p),height_val(p)); - mp_miny=ty_val(p); - mp_maxy=mp_miny; - if ( y0<y1 ) { mp_miny=mp_miny+y0; mp_maxy=mp_maxy+y1; } - else { mp_miny=mp_miny+y1; mp_maxy=mp_maxy+y0; } - if ( x1<0 ) mp_miny=mp_miny+x1; else mp_maxy=mp_maxy+x1; - mp_adjust_bbox(mp, h); - break; - -@ This case involves a recursive call that advances |bblast(h)| to the node of -type |mp_stop_clip_code| that matches |p|. - -@<Other cases for updating the bounding box...@>= -case mp_start_clip_code: - mp_path_bbox(mp, mp_path_p(p)); - x0=mp_minx; y0=mp_miny; - x1=mp_maxx; y1=mp_maxy; - sminx=minx_val(h); sminy=miny_val(h); - smaxx=maxx_val(h); smaxy=maxy_val(h); - @<Reinitialize the bounding box in header |h| and call |set_bbox| recursively - starting at |mp_link(p)|@>; - @<Clip the bounding box in |h| to the rectangle given by |x0|, |x1|, - |y0|, |y1|@>; - mp_minx=sminx; mp_miny=sminy; - mp_maxx=smaxx; mp_maxy=smaxy; - mp_adjust_bbox(mp, h); - break; - -@ @<Reinitialize the bounding box in header |h| and call |set_bbox|...@>= -minx_val(h)=el_gordo; -miny_val(h)=el_gordo; -maxx_val(h)=-el_gordo; -maxy_val(h)=-el_gordo; -mp_set_bbox(mp, h,false) - -@ @<Clip the bounding box in |h| to the rectangle given by |x0|, |x1|,...@>= -if ( minx_val(h)<x0 ) minx_val(h)=x0; -if ( miny_val(h)<y0 ) miny_val(h)=y0; -if ( maxx_val(h)>x1 ) maxx_val(h)=x1; -if ( maxy_val(h)>y1 ) maxy_val(h)=y1 - -@* \[22] Finding an envelope. -When \MP\ has a path and a polygonal pen, it needs to express the desired -shape in terms of things \ps\ can understand. The present task is to compute -a new path that describes the region to be filled. It is convenient to -define this as a two step process where the first step is determining what -offset to use for each segment of the path. - -@ Given a pointer |c| to a cyclic path, -and a pointer~|h| to the first knot of a pen polygon, -the |offset_prep| routine changes the path into cubics that are -associated with particular pen offsets. Thus if the cubic between |p| -and~|q| is associated with the |k|th offset and the cubic between |q| and~|r| -has offset |l| then |mp_info(q)=zero_off+l-k|. (The constant |zero_off| is added -to because |l-k| could be negative.) - -After overwriting the type information with offset differences, we no longer -have a true path so we refer to the knot list returned by |offset_prep| as an -``envelope spec.'' -@^envelope spec@> -Since an envelope spec only determines relative changes in pen offsets, -|offset_prep| sets a global variable |spec_offset| to the relative change from -|h| to the first offset. - -@d zero_off 16384 /* added to offset changes to make them positive */ - -@<Glob...@>= -integer spec_offset; /* number of pen edges between |h| and the initial offset */ - -@ @c -static pointer mp_offset_prep (MP mp,pointer c, pointer h) { - halfword n; /* the number of vertices in the pen polygon */ - pointer c0,p,q,q0,r,w, ww; /* for list manipulation */ - integer k_needed; /* amount to be added to |mp_info(p)| when it is computed */ - pointer w0; /* a pointer to pen offset to use just before |p| */ - scaled dxin,dyin; /* the direction into knot |p| */ - integer turn_amt; /* change in pen offsets for the current cubic */ - @<Other local variables for |offset_prep|@>; - dx0=0; dy0=0; - @<Initialize the pen size~|n|@>; - @<Initialize the incoming direction and pen offset at |c|@>; - p=c; c0=c; k_needed=0; - do { - q=mp_link(p); - @<Split the cubic between |p| and |q|, if necessary, into cubics - associated with single offsets, after which |q| should - point to the end of the final such cubic@>; - NOT_FOUND: - @<Advance |p| to node |q|, removing any ``dead'' cubics that - might have been introduced by the splitting process@>; - } while (q!=c); - @<Fix the offset change in |mp_info(c)| and set |c| to the return value of - |offset_prep|@>; - return c; -} - -@ We shall want to keep track of where certain knots on the cyclic path -wind up in the envelope spec. It doesn't suffice just to keep pointers to -knot nodes because some nodes are deleted while removing dead cubics. Thus -|offset_prep| updates the following pointers - -@<Glob...@>= -pointer spec_p1; -pointer spec_p2; /* pointers to distinguished knots */ - -@ @<Set init...@>= -mp->spec_p1=null; mp->spec_p2=null; - -@ @<Initialize the pen size~|n|@>= -n=0; p=h; -do { - incr(n); - p=mp_link(p); -} while (p!=h) - -@ Since the true incoming direction isn't known yet, we just pick a direction -consistent with the pen offset~|h|. If this is wrong, it can be corrected -later. - -@<Initialize the incoming direction and pen offset at |c|@>= -dxin=mp_x_coord(mp_link(h))-mp_x_coord(knil(h)); -dyin=mp_y_coord(mp_link(h))-mp_y_coord(knil(h)); -if ( (dxin==0)&&(dyin==0) ) { - dxin=mp_y_coord(knil(h))-mp_y_coord(h); - dyin=mp_x_coord(h)-mp_x_coord(knil(h)); -} -w0=h - -@ We must be careful not to remove the only cubic in a cycle. - -But we must also be careful for another reason. If the user-supplied -path starts with a set of degenerate cubics, the target node |q| can -be collapsed to the initial node |p| which might be the same as the -initial node |c| of the curve. This would cause the |offset_prep| routine -to bail out too early, causing distress later on. (See for example -the testcase reported by Bogus\l{}aw Jackowski in tracker id 267, case 52c -on Sarovar.) - -@<Advance |p| to node |q|, removing any ``dead'' cubics...@>= -q0=q; -do { - r=mp_link(p); - if ( mp_x_coord(p)==mp_right_x(p) && mp_y_coord(p)==mp_right_y(p) && - mp_x_coord(p)==mp_left_x(r) && mp_y_coord(p)==mp_left_y(r) && - mp_x_coord(p)==mp_x_coord(r) && mp_y_coord(p)==mp_y_coord(r) && - r!=p ) { - @<Remove the cubic following |p| and update the data structures - to merge |r| into |p|@>; - } - p=r; -} while (p!=q); -/* Check if we removed too much */ -if ((q!=q0)&&(q!=c||c==c0)) - q = mp_link(q) - -@ @<Remove the cubic following |p| and update the data structures...@>= -{ k_needed=mp_info(p)-zero_off; - if ( r==q ) { - q=p; - } else { - mp_info(p)=k_needed+mp_info(r); - k_needed=0; - }; - if ( r==c ) { mp_info(p)=mp_info(c); c=p; }; - if ( r==mp->spec_p1 ) mp->spec_p1=p; - if ( r==mp->spec_p2 ) mp->spec_p2=p; - r=p; mp_remove_cubic(mp, p); -} - -@ Not setting the |info| field of the newly created knot allows the splitting -routine to work for paths. - -@<Declarations@>= -static void mp_split_cubic (MP mp,pointer p, fraction t) ; - -@ @c -void mp_split_cubic (MP mp,pointer p, fraction t) { /* splits the cubic after |p| */ - scaled v; /* an intermediate value */ - pointer q,r; /* for list manipulation */ - q=mp_link(p); r=mp_get_node(mp, knot_node_size); mp_link(p)=r; mp_link(r)=q; - mp_originator(r)=mp_program_code; - mp_left_type(r)=mp_explicit; mp_right_type(r)=mp_explicit; - v=t_of_the_way(mp_right_x(p),mp_left_x(q)); - mp_right_x(p)=t_of_the_way(mp_x_coord(p),mp_right_x(p)); - mp_left_x(q)=t_of_the_way(mp_left_x(q),mp_x_coord(q)); - mp_left_x(r)=t_of_the_way(mp_right_x(p),v); - mp_right_x(r)=t_of_the_way(v,mp_left_x(q)); - mp_x_coord(r)=t_of_the_way(mp_left_x(r),mp_right_x(r)); - v=t_of_the_way(mp_right_y(p),mp_left_y(q)); - mp_right_y(p)=t_of_the_way(mp_y_coord(p),mp_right_y(p)); - mp_left_y(q)=t_of_the_way(mp_left_y(q),mp_y_coord(q)); - mp_left_y(r)=t_of_the_way(mp_right_y(p),v); - mp_right_y(r)=t_of_the_way(v,mp_left_y(q)); - mp_y_coord(r)=t_of_the_way(mp_left_y(r),mp_right_y(r)); -} - -@ This does not set |mp_info(p)| or |mp_right_type(p)|. - -@<Declarations@>= -static void mp_remove_cubic (MP mp,pointer p) ; - -@ @c -void mp_remove_cubic (MP mp,pointer p) { /* removes the dead cubic following~|p| */ - pointer q; /* the node that disappears */ - q=mp_link(p); mp_link(p)=mp_link(q); - mp_right_x(p)=mp_right_x(q); mp_right_y(p)=mp_right_y(q); - mp_free_node(mp, q,knot_node_size); -} - -@ Let $d\prec d'$ mean that the counter-clockwise angle from $d$ to~$d'$ is -strictly between zero and $180^\circ$. Then we can define $d\preceq d'$ to -mean that the angle could be zero or $180^\circ$. If $w_k=(u_k,v_k)$ is the -$k$th pen offset, the $k$th pen edge direction is defined by the formula -$$d_k=(u\k-u_k,\,v\k-v_k).$$ -When listed by increasing $k$, these directions occur in counter-clockwise -order so that $d_k\preceq d\k$ for all~$k$. -The goal of |offset_prep| is to find an offset index~|k| to associate with -each cubic, such that the direction $d(t)$ of the cubic satisfies -$$d_{k-1}\preceq d(t)\preceq d_k\qquad\hbox{for $0\le t\le 1$.}\eqno(*)$$ -We may have to split a cubic into many pieces before each -piece corresponds to a unique offset. - -@<Split the cubic between |p| and |q|, if necessary, into cubics...@>= -mp_info(p)=zero_off+k_needed; -k_needed=0; -@<Prepare for derivative computations; - |goto not_found| if the current cubic is dead@>; -@<Find the initial direction |(dx,dy)|@>; -@<Update |mp_info(p)| and find the offset $w_k$ such that - $d_{k-1}\preceq(\\{dx},\\{dy})\prec d_k$; also advance |w0| for - the direction change at |p|@>; -@<Find the final direction |(dxin,dyin)|@>; -@<Decide on the net change in pen offsets and set |turn_amt|@>; -@<Complete the offset splitting process@>; -w0=mp_pen_walk(mp, w0,turn_amt) - -@ @<Declarations@>= -static pointer mp_pen_walk (MP mp,pointer w, integer k) ; - -@ @c -pointer mp_pen_walk (MP mp,pointer w, integer k) { - /* walk |k| steps around a pen from |w| */ - while ( k>0 ) { w=mp_link(w); decr(k); }; - while ( k<0 ) { w=knil(w); incr(k); }; - return w; -} - -@ The direction of a cubic $B(z_0,z_1,z_2,z_3;t)=\bigl(x(t),y(t)\bigr)$ can be -calculated from the quadratic polynomials -${1\over3}x'(t)=B(x_1-x_0,x_2-x_1,x_3-x_2;t)$ and -${1\over3}y'(t)=B(y_1-y_0,y_2-y_1,y_3-y_2;t)$. -Since we may be calculating directions from several cubics -split from the current one, it is desirable to do these calculations -without losing too much precision. ``Scaled up'' values of the -derivatives, which will be less tainted by accumulated errors than -derivatives found from the cubics themselves, are maintained in -local variables |x0|, |x1|, and |x2|, representing $X_0=2^l(x_1-x_0)$, -$X_1=2^l(x_2-x_1)$, and $X_2=2^l(x_3-x_2)$; similarly |y0|, |y1|, and~|y2| -represent $Y_0=2^l(y_1-y_0)$, $Y_1=2^l(y_2-y_1)$, and $Y_2=2^l(y_3-y_2)$. - -@<Other local variables for |offset_prep|@>= -integer x0,x1,x2,y0,y1,y2; /* representatives of derivatives */ -integer t0,t1,t2; /* coefficients of polynomial for slope testing */ -integer du,dv,dx,dy; /* for directions of the pen and the curve */ -integer dx0,dy0; /* initial direction for the first cubic in the curve */ -integer max_coef; /* used while scaling */ -integer x0a,x1a,x2a,y0a,y1a,y2a; /* intermediate values */ -fraction t; /* where the derivative passes through zero */ -fraction s; /* a temporary value */ - -@ @<Prepare for derivative computations...@>= -x0=mp_right_x(p)-mp_x_coord(p); -x2=mp_x_coord(q)-mp_left_x(q); -x1=mp_left_x(q)-mp_right_x(p); -y0=mp_right_y(p)-mp_y_coord(p); y2=mp_y_coord(q)-mp_left_y(q); -y1=mp_left_y(q)-mp_right_y(p); -max_coef=abs(x0); -if ( abs(x1)>max_coef ) max_coef=abs(x1); -if ( abs(x2)>max_coef ) max_coef=abs(x2); -if ( abs(y0)>max_coef ) max_coef=abs(y0); -if ( abs(y1)>max_coef ) max_coef=abs(y1); -if ( abs(y2)>max_coef ) max_coef=abs(y2); -if ( max_coef==0 ) goto NOT_FOUND; -while ( max_coef<fraction_half ) { - double(max_coef); - double(x0); double(x1); double(x2); - double(y0); double(y1); double(y2); -} - -@ Let us first solve a special case of the problem: Suppose we -know an index~$k$ such that either (i)~$d(t)\succeq d_{k-1}$ for all~$t$ -and $d(0)\prec d_k$, or (ii)~$d(t)\preceq d_k$ for all~$t$ and -$d(0)\succ d_{k-1}$. -Then, in a sense, we're halfway done, since one of the two relations -in $(*)$ is satisfied, and the other couldn't be satisfied for -any other value of~|k|. - -Actually, the conditions can be relaxed somewhat since a relation such as -$d(t)\succeq d_{k-1}$ restricts $d(t)$ to a half plane when all that really -matters is whether $d(t)$ crosses the ray in the $d_{k-1}$ direction from -the origin. The condition for case~(i) becomes $d_{k-1}\preceq d(0)\prec d_k$ -and $d(t)$ never crosses the $d_{k-1}$ ray in the clockwise direction. -Case~(ii) is similar except $d(t)$ cannot cross the $d_k$ ray in the -counterclockwise direction. - -The |fin_offset_prep| subroutine solves the stated subproblem. -It has a parameter called |rise| that is |1| in -case~(i), |-1| in case~(ii). Parameters |x0| through |y2| represent -the derivative of the cubic following |p|. -The |w| parameter should point to offset~$w_k$ and |mp_info(p)| should already -be set properly. The |turn_amt| parameter gives the absolute value of the -overall net change in pen offsets. - -@<Declarations@>= -static void mp_fin_offset_prep (MP mp,pointer p, pointer w, integer - x0,integer x1, integer x2, integer y0, integer y1, integer y2, - integer rise, integer turn_amt) ; - -@ @c -void mp_fin_offset_prep (MP mp,pointer p, pointer w, integer - x0,integer x1, integer x2, integer y0, integer y1, integer y2, - integer rise, integer turn_amt) { - pointer ww; /* for list manipulation */ - scaled du,dv; /* for slope calculation */ - integer t0,t1,t2; /* test coefficients */ - fraction t; /* place where the derivative passes a critical slope */ - fraction s; /* slope or reciprocal slope */ - integer v; /* intermediate value for updating |x0..y2| */ - pointer q; /* original |mp_link(p)| */ - q=mp_link(p); - while (1) { - if ( rise>0 ) ww=mp_link(w); /* a pointer to $w\k$ */ - else ww=knil(w); /* a pointer to $w_{k-1}$ */ - @<Compute test coefficients |(t0,t1,t2)| - for $d(t)$ versus $d_k$ or $d_{k-1}$@>; - t=mp_crossing_point(mp, t0,t1,t2); - if ( t>=fraction_one ) { - if ( turn_amt>0 ) t=fraction_one; else return; - } - @<Split the cubic at $t$, - and split off another cubic if the derivative crosses back@>; - w=ww; - } -} - -@ We want $B(\\{t0},\\{t1},\\{t2};t)$ to be the dot product of $d(t)$ with a -$-90^\circ$ rotation of the vector from |w| to |ww|. This makes the resulting -function cross from positive to negative when $d_{k-1}\preceq d(t)\preceq d_k$ -begins to fail. - -@<Compute test coefficients |(t0,t1,t2)| for $d(t)$ versus...@>= -du=mp_x_coord(ww)-mp_x_coord(w); dv=mp_y_coord(ww)-mp_y_coord(w); -if ( abs(du)>=abs(dv) ) { - s=mp_make_fraction(mp, dv,du); - t0=mp_take_fraction(mp, x0,s)-y0; - t1=mp_take_fraction(mp, x1,s)-y1; - t2=mp_take_fraction(mp, x2,s)-y2; - if ( du<0 ) { negate(t0); negate(t1); negate(t2); } -} else { - s=mp_make_fraction(mp, du,dv); - t0=x0-mp_take_fraction(mp, y0,s); - t1=x1-mp_take_fraction(mp, y1,s); - t2=x2-mp_take_fraction(mp, y2,s); - if ( dv<0 ) { negate(t0); negate(t1); negate(t2); } -} -if ( t0<0 ) t0=0 /* should be positive without rounding error */ - -@ The curve has crossed $d_k$ or $d_{k-1}$; its initial segment satisfies -$(*)$, and it might cross again and return towards $s_{k-1}$ or $s_k$, -respectively, yielding another solution of $(*)$. - -@<Split the cubic at $t$, and split off another...@>= -{ -mp_split_cubic(mp, p,t); p=mp_link(p); mp_info(p)=zero_off+rise; -decr(turn_amt); -v=t_of_the_way(x0,x1); x1=t_of_the_way(x1,x2); -x0=t_of_the_way(v,x1); -v=t_of_the_way(y0,y1); y1=t_of_the_way(y1,y2); -y0=t_of_the_way(v,y1); -if ( turn_amt<0 ) { - t1=t_of_the_way(t1,t2); - if ( t1>0 ) t1=0; /* without rounding error, |t1| would be |<=0| */ - t=mp_crossing_point(mp, 0,-t1,-t2); - if ( t>fraction_one ) t=fraction_one; - incr(turn_amt); - if ( (t==fraction_one)&&(mp_link(p)!=q) ) { - mp_info(mp_link(p))=mp_info(mp_link(p))-rise; - } else { - mp_split_cubic(mp, p,t); mp_info(mp_link(p))=zero_off-rise; - v=t_of_the_way(x1,x2); x1=t_of_the_way(x0,x1); - x2=t_of_the_way(x1,v); - v=t_of_the_way(y1,y2); y1=t_of_the_way(y0,y1); - y2=t_of_the_way(y1,v); - } -} -} - -@ Now we must consider the general problem of |offset_prep|, when -nothing is known about a given cubic. We start by finding its -direction in the vicinity of |t=0|. - -If $z'(t)=0$, the given cubic is numerically unstable but |offset_prep| -has not yet introduced any more numerical errors. Thus we can compute -the true initial direction for the given cubic, even if it is almost -degenerate. - -@<Find the initial direction |(dx,dy)|@>= -dx=x0; dy=y0; -if ( dx==0 && dy==0 ) { - dx=x1; dy=y1; - if ( dx==0 && dy==0 ) { - dx=x2; dy=y2; - } -} -if ( p==c ) { dx0=dx; dy0=dy; } - -@ @<Find the final direction |(dxin,dyin)|@>= -dxin=x2; dyin=y2; -if ( dxin==0 && dyin==0 ) { - dxin=x1; dyin=y1; - if ( dxin==0 && dyin==0 ) { - dxin=x0; dyin=y0; - } -} - -@ The next step is to bracket the initial direction between consecutive -edges of the pen polygon. We must be careful to turn clockwise only if -this makes the turn less than $180^\circ$. (A $180^\circ$ turn must be -counter-clockwise in order to make \&{doublepath} envelopes come out -@:double_path_}{\&{doublepath} primitive@> -right.) This code depends on |w0| being the offset for |(dxin,dyin)|. - -@<Update |mp_info(p)| and find the offset $w_k$ such that...@>= -turn_amt=mp_get_turn_amt(mp,w0,dx,dy,(mp_ab_vs_cd(mp, dy,dxin,dx,dyin)>=0)); -w=mp_pen_walk(mp, w0, turn_amt); -w0=w; -mp_info(p)=mp_info(p)+turn_amt - -@ Decide how many pen offsets to go away from |w| in order to find the offset -for |(dx,dy)|, going counterclockwise if |ccw| is |true|. This assumes that -|w| is the offset for some direction $(x',y')$ from which the angle to |(dx,dy)| -in the sense determined by |ccw| is less than or equal to $180^\circ$. - -If the pen polygon has only two edges, they could both be parallel -to |(dx,dy)|. In this case, we must be careful to stop after crossing the first -such edge in order to avoid an infinite loop. - -@<Declarations@>= -static integer mp_get_turn_amt (MP mp,pointer w, scaled dx, - scaled dy, boolean ccw); - -@ @c -integer mp_get_turn_amt (MP mp,pointer w, scaled dx, - scaled dy, boolean ccw) { - pointer ww; /* a neighbor of knot~|w| */ - integer s; /* turn amount so far */ - integer t; /* |ab_vs_cd| result */ - s=0; - if ( ccw ) { - ww=mp_link(w); - do { - t=mp_ab_vs_cd(mp, dy,(mp_x_coord(ww)-mp_x_coord(w)), - dx,(mp_y_coord(ww)-mp_y_coord(w))); - if ( t<0 ) break; - incr(s); - w=ww; ww=mp_link(ww); - } while (t>0); - } else { - ww=knil(w); - while ( mp_ab_vs_cd(mp, dy,(mp_x_coord(w)-mp_x_coord(ww)), - dx,(mp_y_coord(w)-mp_y_coord(ww))) < 0) { - decr(s); - w=ww; ww=knil(ww); - } - } - return s; -} - -@ When we're all done, the final offset is |w0| and the final curve direction -is |(dxin,dyin)|. With this knowledge of the incoming direction at |c|, we -can correct |mp_info(c)| which was erroneously based on an incoming offset -of~|h|. - -@d fix_by(A) mp_info(c)=mp_info(c)+(A) - -@<Fix the offset change in |mp_info(c)| and set |c| to the return value of...@>= -mp->spec_offset=mp_info(c)-zero_off; -if ( mp_link(c)==c ) { - mp_info(c)=zero_off+n; -} else { - fix_by(k_needed); - while ( w0!=h ) { fix_by(1); w0=mp_link(w0); }; - while ( mp_info(c)<=zero_off-n ) fix_by(n); - while ( mp_info(c)>zero_off ) fix_by(-n); - if ( (mp_info(c)!=zero_off)&&(mp_ab_vs_cd(mp, dy0,dxin,dx0,dyin)>=0) ) fix_by(n); -} - -@ Finally we want to reduce the general problem to situations that -|fin_offset_prep| can handle. We split the cubic into at most three parts -with respect to $d_{k-1}$, and apply |fin_offset_prep| to each part. - -@<Complete the offset splitting process@>= -ww=knil(w); -@<Compute test coeff...@>; -@<Find the first |t| where $d(t)$ crosses $d_{k-1}$ or set - |t:=fraction_one+1|@>; -if ( t>fraction_one ) { - mp_fin_offset_prep(mp, p,w,x0,x1,x2,y0,y1,y2,1,turn_amt); -} else { - mp_split_cubic(mp, p,t); r=mp_link(p); - x1a=t_of_the_way(x0,x1); x1=t_of_the_way(x1,x2); - x2a=t_of_the_way(x1a,x1); - y1a=t_of_the_way(y0,y1); y1=t_of_the_way(y1,y2); - y2a=t_of_the_way(y1a,y1); - mp_fin_offset_prep(mp, p,w,x0,x1a,x2a,y0,y1a,y2a,1,0); x0=x2a; y0=y2a; - mp_info(r)=zero_off-1; - if ( turn_amt>=0 ) { - t1=t_of_the_way(t1,t2); - if ( t1>0 ) t1=0; - t=mp_crossing_point(mp, 0,-t1,-t2); - if ( t>fraction_one ) t=fraction_one; - @<Split off another rising cubic for |fin_offset_prep|@>; - mp_fin_offset_prep(mp, r,ww,x0,x1,x2,y0,y1,y2,-1,0); - } else { - mp_fin_offset_prep(mp, r,ww,x0,x1,x2,y0,y1,y2,-1,(-1-turn_amt)); - } -} - -@ @<Split off another rising cubic for |fin_offset_prep|@>= -mp_split_cubic(mp, r,t); mp_info(mp_link(r))=zero_off+1; -x1a=t_of_the_way(x1,x2); x1=t_of_the_way(x0,x1); -x0a=t_of_the_way(x1,x1a); -y1a=t_of_the_way(y1,y2); y1=t_of_the_way(y0,y1); -y0a=t_of_the_way(y1,y1a); -mp_fin_offset_prep(mp, mp_link(r),w,x0a,x1a,x2,y0a,y1a,y2,1,turn_amt); -x2=x0a; y2=y0a - -@ At this point, the direction of the incoming pen edge is |(-du,-dv)|. -When the component of $d(t)$ perpendicular to |(-du,-dv)| crosses zero, we -need to decide whether the directions are parallel or antiparallel. We -can test this by finding the dot product of $d(t)$ and |(-du,-dv)|, but this -should be avoided when the value of |turn_amt| already determines the -answer. If |t2<0|, there is one crossing and it is antiparallel only if -|turn_amt>=0|. If |turn_amt<0|, there should always be at least one -crossing and the first crossing cannot be antiparallel. - -@<Find the first |t| where $d(t)$ crosses $d_{k-1}$ or set...@>= -t=mp_crossing_point(mp, t0,t1,t2); -if ( turn_amt>=0 ) { - if ( t2<0 ) { - t=fraction_one+1; - } else { - u0=t_of_the_way(x0,x1); - u1=t_of_the_way(x1,x2); - ss=mp_take_fraction(mp, -du,t_of_the_way(u0,u1)); - v0=t_of_the_way(y0,y1); - v1=t_of_the_way(y1,y2); - ss=ss+mp_take_fraction(mp, -dv,t_of_the_way(v0,v1)); - if ( ss<0 ) t=fraction_one+1; - } -} else if ( t>fraction_one ) { - t=fraction_one; -} - -@ @<Other local variables for |offset_prep|@>= -integer u0,u1,v0,v1; /* intermediate values for $d(t)$ calculation */ -integer ss = 0; /* the part of the dot product computed so far */ -int d_sign; /* sign of overall change in direction for this cubic */ - -@ If the cubic almost has a cusp, it is a numerically ill-conditioned -problem to decide which way it loops around but that's OK as long we're -consistent. To make \&{doublepath} envelopes work properly, reversing -the path should always change the sign of |turn_amt|. - -@<Decide on the net change in pen offsets and set |turn_amt|@>= -d_sign=mp_ab_vs_cd(mp, dx,dyin, dxin,dy); -if ( d_sign==0 ) { - @<Check rotation direction based on node position@> -} -if ( d_sign==0 ) { - if ( dx==0 ) { - if ( dy>0 ) d_sign=1; else d_sign=-1; - } else { - if ( dx>0 ) d_sign=1; else d_sign=-1; - } -} -@<Make |ss| negative if and only if the total change in direction is - more than $180^\circ$@>; -turn_amt=mp_get_turn_amt(mp, w, dxin, dyin, (d_sign>0)); -if ( ss<0 ) turn_amt=turn_amt-d_sign*n - -@ We check rotation direction by looking at the vector connecting the current -node with the next. If its angle with incoming and outgoing tangents has the -same sign, we pick this as |d_sign|, since it means we have a flex, not a cusp. -Otherwise we proceed to the cusp code. - -@<Check rotation direction based on node position@>= -u0=mp_x_coord(q)-mp_x_coord(p); -u1=mp_y_coord(q)-mp_y_coord(p); -d_sign = half(mp_ab_vs_cd(mp, dx, u1, u0, dy)+ - mp_ab_vs_cd(mp, u0, dyin, dxin, u1)); - -@ In order to be invariant under path reversal, the result of this computation -should not change when |x0|, |y0|, $\ldots$ are all negated and |(x0,y0)| is -then swapped with |(x2,y2)|. We make use of the identities -|take_fraction(-a,-b)=take_fraction(a,b)| and -|t_of_the_way(-a,-b)=-(t_of_the_way(a,b))|. - -@<Make |ss| negative if and only if the total change in direction is...@>= -t0=half(mp_take_fraction(mp, x0,y2))-half(mp_take_fraction(mp, x2,y0)); -t1=half(mp_take_fraction(mp, x1,(y0+y2)))-half(mp_take_fraction(mp, y1,(x0+x2))); -if ( t0==0 ) t0=d_sign; /* path reversal always negates |d_sign| */ -if ( t0>0 ) { - t=mp_crossing_point(mp, t0,t1,-t0); - u0=t_of_the_way(x0,x1); - u1=t_of_the_way(x1,x2); - v0=t_of_the_way(y0,y1); - v1=t_of_the_way(y1,y2); -} else { - t=mp_crossing_point(mp, -t0,t1,t0); - u0=t_of_the_way(x2,x1); - u1=t_of_the_way(x1,x0); - v0=t_of_the_way(y2,y1); - v1=t_of_the_way(y1,y0); -} -ss=mp_take_fraction(mp, (x0+x2),t_of_the_way(u0,u1))+ - mp_take_fraction(mp, (y0+y2),t_of_the_way(v0,v1)) - -@ Here's a routine that prints an envelope spec in symbolic form. It assumes -that the |cur_pen| has not been walked around to the first offset. - -@c -static void mp_print_spec (MP mp,pointer cur_spec, pointer cur_pen, const char *s) { - pointer p,q; /* list traversal */ - pointer w; /* the current pen offset */ - mp_print_diagnostic(mp, "Envelope spec",s,true); - p=cur_spec; w=mp_pen_walk(mp, cur_pen,mp->spec_offset); - mp_print_ln(mp); - mp_print_two(mp, mp_x_coord(cur_spec),mp_y_coord(cur_spec)); - mp_print(mp, " % beginning with offset "); - mp_print_two(mp, mp_x_coord(w),mp_y_coord(w)); - do { - while (1) { - q=mp_link(p); - @<Print the cubic between |p| and |q|@>; - p=q; - if ((p==cur_spec) || (mp_info(p)!=zero_off)) - break; - } - if ( mp_info(p)!=zero_off ) { - @<Update |w| as indicated by |mp_info(p)| and print an explanation@>; - } - } while (p!=cur_spec); - mp_print_nl(mp, " & cycle"); - mp_end_diagnostic(mp, true); -} - -@ @<Update |w| as indicated by |mp_info(p)| and print an explanation@>= -{ - w=mp_pen_walk(mp, w, (mp_info(p)-zero_off)); - mp_print(mp, " % "); - if ( mp_info(p)>zero_off ) mp_print(mp, "counter"); - mp_print(mp, "clockwise to offset "); - mp_print_two(mp, mp_x_coord(w),mp_y_coord(w)); -} - -@ @<Print the cubic between |p| and |q|@>= -{ - mp_print_nl(mp, " ..controls "); - mp_print_two(mp, mp_right_x(p),mp_right_y(p)); - mp_print(mp, " and "); - mp_print_two(mp, mp_left_x(q),mp_left_y(q)); - mp_print_nl(mp, " .."); - mp_print_two(mp, mp_x_coord(q),mp_y_coord(q)); -} - -@ Once we have an envelope spec, the remaining task to construct the actual -envelope by offsetting each cubic as determined by the |info| fields in -the knots. First we use |offset_prep| to convert the |c| into an envelope -spec. Then we add the offsets so that |c| becomes a cyclic path that represents -the envelope. - -The |ljoin| and |miterlim| parameters control the treatment of points where the -pen offset changes, and |lcap| controls the endpoints of a \&{doublepath}. -The endpoints are easily located because |c| is given in undoubled form -and then doubled in this procedure. We use |spec_p1| and |spec_p2| to keep -track of the endpoints and treat them like very sharp corners. -Butt end caps are treated like beveled joins; round end caps are treated like -round joins; and square end caps are achieved by setting |join_type:=3|. - -None of these parameters apply to inside joins where the convolution tracing -has retrograde lines. In such cases we use a simple connect-the-endpoints -approach that is achieved by setting |join_type:=2|. - -@c -static pointer mp_make_envelope (MP mp,pointer c, pointer h, quarterword ljoin, - quarterword lcap, scaled miterlim) { - pointer p,q,r,q0; /* for manipulating the path */ - int join_type=0; /* codes |0..3| for mitered, round, beveled, or square */ - pointer w,w0; /* the pen knot for the current offset */ - scaled qx,qy; /* unshifted coordinates of |q| */ - halfword k,k0; /* controls pen edge insertion */ - @<Other local variables for |make_envelope|@>; - dxin=0; dyin=0; dxout=0; dyout=0; - mp->spec_p1=null; mp->spec_p2=null; - @<If endpoint, double the path |c|, and set |spec_p1| and |spec_p2|@>; - @<Use |offset_prep| to compute the envelope spec then walk |h| around to - the initial offset@>; - w=h; - p=c; - do { - q=mp_link(p); q0=q; - qx=mp_x_coord(q); qy=mp_y_coord(q); - k=mp_info(q); - k0=k; w0=w; - if ( k!=zero_off ) { - @<Set |join_type| to indicate how to handle offset changes at~|q|@>; - } - @<Add offset |w| to the cubic from |p| to |q|@>; - while ( k!=zero_off ) { - @<Step |w| and move |k| one step closer to |zero_off|@>; - if ( (join_type==1)||(k==zero_off) ) - q=mp_insert_knot(mp, q,qx+mp_x_coord(w),qy+mp_y_coord(w)); - }; - if ( q!=mp_link(p) ) { - @<Set |p=mp_link(p)| and add knots between |p| and |q| as - required by |join_type|@>; - } - p=q; - } while (q0!=c); - return c; -} - -@ @<Use |offset_prep| to compute the envelope spec then walk |h| around to...@>= -c=mp_offset_prep(mp, c,h); -if ( mp->internal[mp_tracing_specs]>0 ) - mp_print_spec(mp, c,h,""); -h=mp_pen_walk(mp, h,mp->spec_offset) - -@ Mitered and squared-off joins depend on path directions that are difficult to -compute for degenerate cubics. The envelope spec computed by |offset_prep| can -have degenerate cubics only if the entire cycle collapses to a single -degenerate cubic. Setting |join_type:=2| in this case makes the computed -envelope degenerate as well. - -@<Set |join_type| to indicate how to handle offset changes at~|q|@>= -if ( k<zero_off ) { - join_type=2; -} else { - if ( (q!=mp->spec_p1)&&(q!=mp->spec_p2) ) join_type=ljoin; - else if ( lcap==2 ) join_type=3; - else join_type=2-lcap; - if ( (join_type==0)||(join_type==3) ) { - @<Set the incoming and outgoing directions at |q|; in case of - degeneracy set |join_type:=2|@>; - if ( join_type==0 ) { - @<If |miterlim| is less than the secant of half the angle at |q| - then set |join_type:=2|@>; - } - } -} - -@ @<If |miterlim| is less than the secant of half the angle at |q|...@>= -{ - tmp=mp_take_fraction(mp, miterlim,fraction_half+ - half(mp_take_fraction(mp, dxin,dxout)+mp_take_fraction(mp, dyin,dyout))); - if ( tmp<unity ) - if ( mp_take_scaled(mp, miterlim,tmp)<unity ) join_type=2; -} - -@ @<Other local variables for |make_envelope|@>= -fraction dxin,dyin,dxout,dyout; /* directions at |q| when square or mitered */ -scaled tmp; /* a temporary value */ - -@ The coordinates of |p| have already been shifted unless |p| is the first -knot in which case they get shifted at the very end. - -@<Add offset |w| to the cubic from |p| to |q|@>= -mp_right_x(p)=mp_right_x(p)+mp_x_coord(w); -mp_right_y(p)=mp_right_y(p)+mp_y_coord(w); -mp_left_x(q)=mp_left_x(q)+mp_x_coord(w); -mp_left_y(q)=mp_left_y(q)+mp_y_coord(w); -mp_x_coord(q)=mp_x_coord(q)+mp_x_coord(w); -mp_y_coord(q)=mp_y_coord(q)+mp_y_coord(w); -mp_left_type(q)=mp_explicit; -mp_right_type(q)=mp_explicit - -@ @<Step |w| and move |k| one step closer to |zero_off|@>= -if ( k>zero_off ){ w=mp_link(w); decr(k); } -else { w=knil(w); incr(k); } - -@ The cubic from |q| to the new knot at |(x,y)| becomes a line segment and -the |mp_right_x| and |mp_right_y| fields of |r| are set from |q|. This is done in -case the cubic containing these control points is ``yet to be examined.'' - -@<Declarations@>= -static pointer mp_insert_knot (MP mp,pointer q, scaled x, scaled y); - -@ @c -pointer mp_insert_knot (MP mp,pointer q, scaled x, scaled y) { - /* returns the inserted knot */ - pointer r; /* the new knot */ - r=mp_get_node(mp, knot_node_size); - mp_link(r)=mp_link(q); mp_link(q)=r; - mp_right_x(r)=mp_right_x(q); - mp_right_y(r)=mp_right_y(q); - mp_x_coord(r)=x; - mp_y_coord(r)=y; - mp_right_x(q)=mp_x_coord(q); - mp_right_y(q)=mp_y_coord(q); - mp_left_x(r)=mp_x_coord(r); - mp_left_y(r)=mp_y_coord(r); - mp_left_type(r)=mp_explicit; - mp_right_type(r)=mp_explicit; - mp_originator(r)=mp_program_code; - return r; -} - -@ After setting |p:=mp_link(p)|, either |join_type=1| or |q=mp_link(p)|. - -@<Set |p=mp_link(p)| and add knots between |p| and |q| as...@>= -{ - p=mp_link(p); - if ( (join_type==0)||(join_type==3) ) { - if ( join_type==0 ) { - @<Insert a new knot |r| between |p| and |q| as required for a mitered join@> - } else { - @<Make |r| the last of two knots inserted between |p| and |q| to form a - squared join@>; - } - if ( r!=null ) { - mp_right_x(r)=mp_x_coord(r); - mp_right_y(r)=mp_y_coord(r); - } - } -} - -@ For very small angles, adding a knot is unnecessary and would cause numerical -problems, so we just set |r:=null| in that case. - -@<Insert a new knot |r| between |p| and |q| as required for a mitered join@>= -{ - det=mp_take_fraction(mp, dyout,dxin)-mp_take_fraction(mp, dxout,dyin); - if ( abs(det)<26844 ) { - r=null; /* sine $<10^{-4}$ */ - } else { - tmp=mp_take_fraction(mp, mp_x_coord(q)-mp_x_coord(p),dyout)- - mp_take_fraction(mp, mp_y_coord(q)-mp_y_coord(p),dxout); - tmp=mp_make_fraction(mp, tmp,det); - r=mp_insert_knot(mp, p,mp_x_coord(p)+mp_take_fraction(mp, tmp,dxin), - mp_y_coord(p)+mp_take_fraction(mp, tmp,dyin)); - } -} - -@ @<Other local variables for |make_envelope|@>= -fraction det; /* a determinant used for mitered join calculations */ - -@ @<Make |r| the last of two knots inserted between |p| and |q| to form a...@>= -{ - ht_x=mp_y_coord(w)-mp_y_coord(w0); - ht_y=mp_x_coord(w0)-mp_x_coord(w); - while ( (abs(ht_x)<fraction_half)&&(abs(ht_y)<fraction_half) ) { - ht_x+=ht_x; ht_y+=ht_y; - } - @<Scan the pen polygon between |w0| and |w| and make |max_ht| the range dot - product with |(ht_x,ht_y)|@>; - tmp=mp_make_fraction(mp, max_ht,mp_take_fraction(mp, dxin,ht_x)+ - mp_take_fraction(mp, dyin,ht_y)); - r=mp_insert_knot(mp, p,mp_x_coord(p)+mp_take_fraction(mp, tmp,dxin), - mp_y_coord(p)+mp_take_fraction(mp, tmp,dyin)); - tmp=mp_make_fraction(mp, max_ht,mp_take_fraction(mp, dxout,ht_x)+ - mp_take_fraction(mp, dyout,ht_y)); - r=mp_insert_knot(mp, r,mp_x_coord(q)+mp_take_fraction(mp, tmp,dxout), - mp_y_coord(q)+mp_take_fraction(mp, tmp,dyout)); -} - -@ @<Other local variables for |make_envelope|@>= -fraction ht_x,ht_y; /* perpendicular to the segment from |p| to |q| */ -scaled max_ht; /* maximum height of the pen polygon above the |w0|-|w| line */ -halfword kk; /* keeps track of the pen vertices being scanned */ -pointer ww; /* the pen vertex being tested */ - -@ The dot product of the vector from |w0| to |ww| with |(ht_x,ht_y)| ranges -from zero to |max_ht|. - -@<Scan the pen polygon between |w0| and |w| and make |max_ht| the range...@>= -max_ht=0; -kk=zero_off; -ww=w; -while (1) { - @<Step |ww| and move |kk| one step closer to |k0|@>; - if ( kk==k0 ) break; - tmp=mp_take_fraction(mp, (mp_x_coord(ww)-mp_x_coord(w0)),ht_x)+ - mp_take_fraction(mp, (mp_y_coord(ww)-mp_y_coord(w0)),ht_y); - if ( tmp>max_ht ) max_ht=tmp; -} - - -@ @<Step |ww| and move |kk| one step closer to |k0|@>= -if ( kk>k0 ) { ww=mp_link(ww); decr(kk); } -else { ww=knil(ww); incr(kk); } - -@ @<If endpoint, double the path |c|, and set |spec_p1| and |spec_p2|@>= -if ( mp_left_type(c)==mp_endpoint ) { - mp->spec_p1=mp_htap_ypoc(mp, c); - mp->spec_p2=mp->path_tail; - mp_originator(mp->spec_p1)=mp_program_code; - mp_link(mp->spec_p2)=mp_link(mp->spec_p1); - mp_link(mp->spec_p1)=c; - mp_remove_cubic(mp, mp->spec_p1); - c=mp->spec_p1; - if ( c!=mp_link(c) ) { - mp_originator(mp->spec_p2)=mp_program_code; - mp_remove_cubic(mp, mp->spec_p2); - } else { - @<Make |c| look like a cycle of length one@>; - } -} - -@ @<Make |c| look like a cycle of length one@>= -{ - mp_left_type(c)=mp_explicit; mp_right_type(c)=mp_explicit; - mp_left_x(c)=mp_x_coord(c); mp_left_y(c)=mp_y_coord(c); - mp_right_x(c)=mp_x_coord(c); mp_right_y(c)=mp_y_coord(c); -} - -@ In degenerate situations we might have to look at the knot preceding~|q|. -That knot is |p| but if |p<>c|, its coordinates have already been offset by |w|. - -@<Set the incoming and outgoing directions at |q|; in case of...@>= -dxin=mp_x_coord(q)-mp_left_x(q); -dyin=mp_y_coord(q)-mp_left_y(q); -if ( (dxin==0)&&(dyin==0) ) { - dxin=mp_x_coord(q)-mp_right_x(p); - dyin=mp_y_coord(q)-mp_right_y(p); - if ( (dxin==0)&&(dyin==0) ) { - dxin=mp_x_coord(q)-mp_x_coord(p); - dyin=mp_y_coord(q)-mp_y_coord(p); - if ( p!=c ) { /* the coordinates of |p| have been offset by |w| */ - dxin=dxin+mp_x_coord(w); - dyin=dyin+mp_y_coord(w); - } - } -} -tmp=mp_pyth_add(mp, dxin,dyin); -if ( tmp==0 ) { - join_type=2; -} else { - dxin=mp_make_fraction(mp, dxin,tmp); - dyin=mp_make_fraction(mp, dyin,tmp); - @<Set the outgoing direction at |q|@>; -} - -@ If |q=c| then the coordinates of |r| and the control points between |q| -and~|r| have already been offset by |h|. - -@<Set the outgoing direction at |q|@>= -dxout=mp_right_x(q)-mp_x_coord(q); -dyout=mp_right_y(q)-mp_y_coord(q); -if ( (dxout==0)&&(dyout==0) ) { - r=mp_link(q); - dxout=mp_left_x(r)-mp_x_coord(q); - dyout=mp_left_y(r)-mp_y_coord(q); - if ( (dxout==0)&&(dyout==0) ) { - dxout=mp_x_coord(r)-mp_x_coord(q); - dyout=mp_y_coord(r)-mp_y_coord(q); - } -} -if ( q==c ) { - dxout=dxout-mp_x_coord(h); - dyout=dyout-mp_y_coord(h); -} -tmp=mp_pyth_add(mp, dxout,dyout); -if ( tmp==0 ) mp_confusion(mp, "degenerate spec"); -@:this can't happen degerate spec}{\quad degenerate spec@> -dxout=mp_make_fraction(mp, dxout,tmp); -dyout=mp_make_fraction(mp, dyout,tmp) - -@* \[23] Direction and intersection times. -A path of length $n$ is defined parametrically by functions $x(t)$ and -$y(t)$, for |0<=t<=n|; we can regard $t$ as the ``time'' at which the path -reaches the point $\bigl(x(t),y(t)\bigr)$. In this section of the program -we shall consider operations that determine special times associated with -given paths: the first time that a path travels in a given direction, and -a pair of times at which two paths cross each other. - -@ Let's start with the easier task. The function |find_direction_time| is -given a direction |(x,y)| and a path starting at~|h|. If the path never -travels in direction |(x,y)|, the direction time will be~|-1|; otherwise -it will be nonnegative. - -Certain anomalous cases can arise: If |(x,y)=(0,0)|, so that the given -direction is undefined, the direction time will be~0. If $\bigl(x'(t), -y'(t)\bigr)=(0,0)$, so that the path direction is undefined, it will be -assumed to match any given direction at time~|t|. - -The routine solves this problem in nondegenerate cases by rotating the path -and the given direction so that |(x,y)=(1,0)|; i.e., the main task will be -to find when a given path first travels ``due east.'' - -@c -static scaled mp_find_direction_time (MP mp,scaled x, scaled y, pointer h) { - scaled max; /* $\max\bigl(\vert x\vert,\vert y\vert\bigr)$ */ - pointer p,q; /* for list traversal */ - scaled n; /* the direction time at knot |p| */ - scaled tt; /* the direction time within a cubic */ - @<Other local variables for |find_direction_time|@>; - @<Normalize the given direction for better accuracy; - but |return| with zero result if it's zero@>; - n=0; p=h; phi=0; - while (1) { - if ( mp_right_type(p)==mp_endpoint ) break; - q=mp_link(p); - @<Rotate the cubic between |p| and |q|; then - |goto found| if the rotated cubic travels due east at some time |tt|; - but |break| if an entire cyclic path has been traversed@>; - p=q; n=n+unity; - } - return (-unity); -FOUND: - return (n+tt); -} - -@ @<Normalize the given direction for better accuracy...@>= -if ( abs(x)<abs(y) ) { - x=mp_make_fraction(mp, x,abs(y)); - if ( y>0 ) y=fraction_one; else y=-fraction_one; -} else if ( x==0 ) { - return 0; -} else { - y=mp_make_fraction(mp, y,abs(x)); - if ( x>0 ) x=fraction_one; else x=-fraction_one; -} - -@ Since we're interested in the tangent directions, we work with the -derivative $${1\over3}B'(x_0,x_1,x_2,x_3;t)= -B(x_1-x_0,x_2-x_1,x_3-x_2;t)$$ instead of -$B(x_0,x_1,x_2,x_3;t)$ itself. The derived coefficients are also scaled up -in order to achieve better accuracy. - -The given path may turn abruptly at a knot, and it might pass the critical -tangent direction at such a time. Therefore we remember the direction |phi| -in which the previous rotated cubic was traveling. (The value of |phi| will be -undefined on the first cubic, i.e., when |n=0|.) - -@<Rotate the cubic between |p| and |q|; then...@>= -tt=0; -@<Set local variables |x1,x2,x3| and |y1,y2,y3| to multiples of the control - points of the rotated derivatives@>; -if ( y1==0 ) if ( x1>=0 ) goto FOUND; -if ( n>0 ) { - @<Exit to |found| if an eastward direction occurs at knot |p|@>; - if ( p==h ) break; - }; -if ( (x3!=0)||(y3!=0) ) phi=mp_n_arg(mp, x3,y3); -@<Exit to |found| if the curve whose derivatives are specified by - |x1,x2,x3,y1,y2,y3| travels eastward at some time~|tt|@> - -@ @<Other local variables for |find_direction_time|@>= -scaled x1,x2,x3,y1,y2,y3; /* multiples of rotated derivatives */ -angle theta,phi; /* angles of exit and entry at a knot */ -fraction t; /* temp storage */ - -@ @<Set local variables |x1,x2,x3| and |y1,y2,y3| to multiples...@>= -x1=mp_right_x(p)-mp_x_coord(p); x2=mp_left_x(q)-mp_right_x(p); -x3=mp_x_coord(q)-mp_left_x(q); -y1=mp_right_y(p)-mp_y_coord(p); y2=mp_left_y(q)-mp_right_y(p); -y3=mp_y_coord(q)-mp_left_y(q); -max=abs(x1); -if ( abs(x2)>max ) max=abs(x2); -if ( abs(x3)>max ) max=abs(x3); -if ( abs(y1)>max ) max=abs(y1); -if ( abs(y2)>max ) max=abs(y2); -if ( abs(y3)>max ) max=abs(y3); -if ( max==0 ) goto FOUND; -while ( max<fraction_half ){ - max+=max; x1+=x1; x2+=x2; x3+=x3; - y1+=y1; y2+=y2; y3+=y3; -} -t=x1; x1=mp_take_fraction(mp, x1,x)+mp_take_fraction(mp, y1,y); -y1=mp_take_fraction(mp, y1,x)-mp_take_fraction(mp, t,y); -t=x2; x2=mp_take_fraction(mp, x2,x)+mp_take_fraction(mp, y2,y); -y2=mp_take_fraction(mp, y2,x)-mp_take_fraction(mp, t,y); -t=x3; x3=mp_take_fraction(mp, x3,x)+mp_take_fraction(mp, y3,y); -y3=mp_take_fraction(mp, y3,x)-mp_take_fraction(mp, t,y) - -@ @<Exit to |found| if an eastward direction occurs at knot |p|@>= -theta=mp_n_arg(mp, x1,y1); -if ( theta>=0 ) if ( phi<=0 ) if ( phi>=theta-one_eighty_deg ) goto FOUND; -if ( theta<=0 ) if ( phi>=0 ) if ( phi<=theta+one_eighty_deg ) goto FOUND - -@ In this step we want to use the |crossing_point| routine to find the -roots of the quadratic equation $B(y_1,y_2,y_3;t)=0$. -Several complications arise: If the quadratic equation has a double root, -the curve never crosses zero, and |crossing_point| will find nothing; -this case occurs iff $y_1y_3=y_2^2$ and $y_1y_2<0$. If the quadratic -equation has simple roots, or only one root, we may have to negate it -so that $B(y_1,y_2,y_3;t)$ crosses from positive to negative at its first root. -And finally, we need to do special things if $B(y_1,y_2,y_3;t)$ is -identically zero. - -@ @<Exit to |found| if the curve whose derivatives are specified by...@>= -if ( x1<0 ) if ( x2<0 ) if ( x3<0 ) goto DONE; -if ( mp_ab_vs_cd(mp, y1,y3,y2,y2)==0 ) { - @<Handle the test for eastward directions when $y_1y_3=y_2^2$; - either |goto found| or |goto done|@>; -} -if ( y1<=0 ) { - if ( y1<0 ) { y1=-y1; y2=-y2; y3=-y3; } - else if ( y2>0 ){ y2=-y2; y3=-y3; }; -} -@<Check the places where $B(y_1,y_2,y_3;t)=0$ to see if - $B(x_1,x_2,x_3;t)\ge0$@>; -DONE: - -@ The quadratic polynomial $B(y_1,y_2,y_3;t)$ begins |>=0| and has at most -two roots, because we know that it isn't identically zero. - -It must be admitted that the |crossing_point| routine is not perfectly accurate; -rounding errors might cause it to find a root when $y_1y_3>y_2^2$, or to -miss the roots when $y_1y_3<y_2^2$. The rotation process is itself -subject to rounding errors. Yet this code optimistically tries to -do the right thing. - -@d we_found_it { tt=(t+04000) / 010000; goto FOUND; } - -@<Check the places where $B(y_1,y_2,y_3;t)=0$...@>= -t=mp_crossing_point(mp, y1,y2,y3); -if ( t>fraction_one ) goto DONE; -y2=t_of_the_way(y2,y3); -x1=t_of_the_way(x1,x2); -x2=t_of_the_way(x2,x3); -x1=t_of_the_way(x1,x2); -if ( x1>=0 ) we_found_it; -if ( y2>0 ) y2=0; -tt=t; t=mp_crossing_point(mp, 0,-y2,-y3); -if ( t>fraction_one ) goto DONE; -x1=t_of_the_way(x1,x2); -x2=t_of_the_way(x2,x3); -if ( t_of_the_way(x1,x2)>=0 ) { - t=t_of_the_way(tt,fraction_one); we_found_it; -} - -@ @<Handle the test for eastward directions when $y_1y_3=y_2^2$; - either |goto found| or |goto done|@>= -{ - if ( mp_ab_vs_cd(mp, y1,y2,0,0)<0 ) { - t=mp_make_fraction(mp, y1,y1-y2); - x1=t_of_the_way(x1,x2); - x2=t_of_the_way(x2,x3); - if ( t_of_the_way(x1,x2)>=0 ) we_found_it; - } else if ( y3==0 ) { - if ( y1==0 ) { - @<Exit to |found| if the derivative $B(x_1,x_2,x_3;t)$ becomes |>=0|@>; - } else if ( x3>=0 ) { - tt=unity; goto FOUND; - } - } - goto DONE; -} - -@ At this point we know that the derivative of |y(t)| is identically zero, -and that |x1<0|; but either |x2>=0| or |x3>=0|, so there's some hope of -traveling east. - -@<Exit to |found| if the derivative $B(x_1,x_2,x_3;t)$ becomes |>=0|...@>= -{ - t=mp_crossing_point(mp, -x1,-x2,-x3); - if ( t<=fraction_one ) we_found_it; - if ( mp_ab_vs_cd(mp, x1,x3,x2,x2)<=0 ) { - t=mp_make_fraction(mp, x1,x1-x2); we_found_it; - } -} - -@ The intersection of two cubics can be found by an interesting variant -of the general bisection scheme described in the introduction to -|crossing_point|.\ -Given $w(t)=B(w_0,w_1,w_2,w_3;t)$ and $z(t)=B(z_0,z_1,z_2,z_3;t)$, -we wish to find a pair of times $(t_1,t_2)$ such that $w(t_1)=z(t_2)$, -if an intersection exists. First we find the smallest rectangle that -encloses the points $\{w_0,w_1,w_2,w_3\}$ and check that it overlaps -the smallest rectangle that encloses -$\{z_0,z_1,z_2,z_3\}$; if not, the cubics certainly don't intersect. -But if the rectangles do overlap, we bisect the intervals, getting -new cubics $w'$ and~$w''$, $z'$~and~$z''$; the intersection routine first -tries for an intersection between $w'$ and~$z'$, then (if unsuccessful) -between $w'$ and~$z''$, then (if still unsuccessful) between $w''$ and~$z'$, -finally (if thrice unsuccessful) between $w''$ and~$z''$. After $l$~successful -levels of bisection we will have determined the intersection times $t_1$ -and~$t_2$ to $l$~bits of accuracy. - -\def\submin{_{\rm min}} \def\submax{_{\rm max}} -As before, it is better to work with the numbers $W_k=2^l(w_k-w_{k-1})$ -and $Z_k=2^l(z_k-z_{k-1})$ rather than the coefficients $w_k$ and $z_k$ -themselves. We also need one other quantity, $\Delta=2^l(w_0-z_0)$, -to determine when the enclosing rectangles overlap. Here's why: -The $x$~coordinates of~$w(t)$ are between $u\submin$ and $u\submax$, -and the $x$~coordinates of~$z(t)$ are between $x\submin$ and $x\submax$, -if we write $w_k=(u_k,v_k)$ and $z_k=(x_k,y_k)$ and $u\submin= -\min(u_0,u_1,u_2,u_3)$, etc. These intervals of $x$~coordinates -overlap if and only if $u\submin\L x\submax$ and -$x\submin\L u\submax$. Letting -$$U\submin=\min(0,U_1,U_1+U_2,U_1+U_2+U_3),\; - U\submax=\max(0,U_1,U_1+U_2,U_1+U_2+U_3),$$ -we have $2^lu\submin=2^lu_0+U\submin$, etc.; the condition for overlap -reduces to -$$X\submin-U\submax\L 2^l(u_0-x_0)\L X\submax-U\submin.$$ -Thus we want to maintain the quantity $2^l(u_0-x_0)$; similarly, -the quantity $2^l(v_0-y_0)$ accounts for the $y$~coordinates. The -coordinates of $\Delta=2^l(w_0-z_0)$ must stay bounded as $l$ increases, -because of the overlap condition; i.e., we know that $X\submin$, -$X\submax$, and their relatives are bounded, hence $X\submax- -U\submin$ and $X\submin-U\submax$ are bounded. - -@ Incidentally, if the given cubics intersect more than once, the process -just sketched will not necessarily find the lexicographically smallest pair -$(t_1,t_2)$. The solution actually obtained will be smallest in ``shuffled -order''; i.e., if $t_1=(.a_1a_2\ldots a_{16})_2$ and -$t_2=(.b_1b_2\ldots b_{16})_2$, then we will minimize -$a_1b_1a_2b_2\ldots a_{16}b_{16}$, not -$a_1a_2\ldots a_{16}b_1b_2\ldots b_{16}$. -Shuffled order agrees with lexicographic order if all pairs of solutions -$(t_1,t_2)$ and $(t_1',t_2')$ have the property that $t_1<t_1'$ iff -$t_2<t_2'$; but in general, lexicographic order can be quite different, -and the bisection algorithm would be substantially less efficient if it were -constrained by lexicographic order. - -For example, suppose that an overlap has been found for $l=3$ and -$(t_1,t_2)= (.101,.011)$ in binary, but that no overlap is produced by -either of the alternatives $(.1010,.0110)$, $(.1010,.0111)$ at level~4. -Then there is probably an intersection in one of the subintervals -$(.1011,.011x)$; but lexicographic order would require us to explore -$(.1010,.1xxx)$ and $(.1011,.00xx)$ and $(.1011,.010x)$ first. We wouldn't -want to store all of the subdivision data for the second path, so the -subdivisions would have to be regenerated many times. Such inefficiencies -would be associated with every `1' in the binary representation of~$t_1$. - -@ The subdivision process introduces rounding errors, hence we need to -make a more liberal test for overlap. It is not hard to show that the -computed values of $U_i$ differ from the truth by at most~$l$, on -level~$l$, hence $U\submin$ and $U\submax$ will be at most $3l$ in error. -If $\beta$ is an upper bound on the absolute error in the computed -components of $\Delta=(|delx|,|dely|)$ on level~$l$, we will replace -the test `$X\submin-U\submax\L|delx|$' by the more liberal test -`$X\submin-U\submax\L|delx|+|tol|$', where $|tol|=6l+\beta$. - -More accuracy is obtained if we try the algorithm first with |tol=0|; -the more liberal tolerance is used only if an exact approach fails. -It is convenient to do this double-take by letting `3' in the preceding -paragraph be a parameter, which is first 0, then 3. - -@<Glob...@>= -unsigned int tol_step; /* either 0 or 3, usually */ - -@ We shall use an explicit stack to implement the recursive bisection -method described above. The |bisect_stack| array will contain numerous 5-word -packets like $(U_1,U_2,U_3,U\submin,U\submax)$, as well as 20-word packets -comprising the 5-word packets for $U$, $V$, $X$, and~$Y$. - -The following macros define the allocation of stack positions to -the quantities needed for bisection-intersection. - -@d stack_1(A) mp->bisect_stack[(A)] /* $U_1$, $V_1$, $X_1$, or $Y_1$ */ -@d stack_2(A) mp->bisect_stack[(A)+1] /* $U_2$, $V_2$, $X_2$, or $Y_2$ */ -@d stack_3(A) mp->bisect_stack[(A)+2] /* $U_3$, $V_3$, $X_3$, or $Y_3$ */ -@d stack_min(A) mp->bisect_stack[(A)+3] - /* $U\submin$, $V\submin$, $X\submin$, or $Y\submin$ */ -@d stack_max(A) mp->bisect_stack[(A)+4] - /* $U\submax$, $V\submax$, $X\submax$, or $Y\submax$ */ -@d int_packets 20 /* number of words to represent $U_k$, $V_k$, $X_k$, and $Y_k$ */ -@# -@d u_packet(A) ((A)-5) -@d v_packet(A) ((A)-10) -@d x_packet(A) ((A)-15) -@d y_packet(A) ((A)-20) -@d l_packets (mp->bisect_ptr-int_packets) -@d r_packets mp->bisect_ptr -@d ul_packet u_packet(l_packets) /* base of $U'_k$ variables */ -@d vl_packet v_packet(l_packets) /* base of $V'_k$ variables */ -@d xl_packet x_packet(l_packets) /* base of $X'_k$ variables */ -@d yl_packet y_packet(l_packets) /* base of $Y'_k$ variables */ -@d ur_packet u_packet(r_packets) /* base of $U''_k$ variables */ -@d vr_packet v_packet(r_packets) /* base of $V''_k$ variables */ -@d xr_packet x_packet(r_packets) /* base of $X''_k$ variables */ -@d yr_packet y_packet(r_packets) /* base of $Y''_k$ variables */ -@# -@d u1l stack_1(ul_packet) /* $U'_1$ */ -@d u2l stack_2(ul_packet) /* $U'_2$ */ -@d u3l stack_3(ul_packet) /* $U'_3$ */ -@d v1l stack_1(vl_packet) /* $V'_1$ */ -@d v2l stack_2(vl_packet) /* $V'_2$ */ -@d v3l stack_3(vl_packet) /* $V'_3$ */ -@d x1l stack_1(xl_packet) /* $X'_1$ */ -@d x2l stack_2(xl_packet) /* $X'_2$ */ -@d x3l stack_3(xl_packet) /* $X'_3$ */ -@d y1l stack_1(yl_packet) /* $Y'_1$ */ -@d y2l stack_2(yl_packet) /* $Y'_2$ */ -@d y3l stack_3(yl_packet) /* $Y'_3$ */ -@d u1r stack_1(ur_packet) /* $U''_1$ */ -@d u2r stack_2(ur_packet) /* $U''_2$ */ -@d u3r stack_3(ur_packet) /* $U''_3$ */ -@d v1r stack_1(vr_packet) /* $V''_1$ */ -@d v2r stack_2(vr_packet) /* $V''_2$ */ -@d v3r stack_3(vr_packet) /* $V''_3$ */ -@d x1r stack_1(xr_packet) /* $X''_1$ */ -@d x2r stack_2(xr_packet) /* $X''_2$ */ -@d x3r stack_3(xr_packet) /* $X''_3$ */ -@d y1r stack_1(yr_packet) /* $Y''_1$ */ -@d y2r stack_2(yr_packet) /* $Y''_2$ */ -@d y3r stack_3(yr_packet) /* $Y''_3$ */ -@# -@d stack_dx mp->bisect_stack[mp->bisect_ptr] /* stacked value of |delx| */ -@d stack_dy mp->bisect_stack[mp->bisect_ptr+1] /* stacked value of |dely| */ -@d stack_tol mp->bisect_stack[mp->bisect_ptr+2] /* stacked value of |tol| */ -@d stack_uv mp->bisect_stack[mp->bisect_ptr+3] /* stacked value of |uv| */ -@d stack_xy mp->bisect_stack[mp->bisect_ptr+4] /* stacked value of |xy| */ -@d int_increment (int_packets+int_packets+5) /* number of stack words per level */ - -@<Glob...@>= -integer *bisect_stack; -integer bisect_ptr; - -@ @<Allocate or initialize ...@>= -mp->bisect_stack = xmalloc((bistack_size+1),sizeof(integer)); - -@ @<Dealloc variables@>= -xfree(mp->bisect_stack); - -@ @<Check the ``constant''...@>= -if ( int_packets+17*int_increment>bistack_size ) mp->bad=19; - -@ Computation of the min and max is a tedious but fairly fast sequence of -instructions; exactly four comparisons are made in each branch. - -@d set_min_max(A) - if ( stack_1((A))<0 ) { - if ( stack_3((A))>=0 ) { - if ( stack_2((A))<0 ) stack_min((A))=stack_1((A))+stack_2((A)); - else stack_min((A))=stack_1((A)); - stack_max((A))=stack_1((A))+stack_2((A))+stack_3((A)); - if ( stack_max((A))<0 ) stack_max((A))=0; - } else { - stack_min((A))=stack_1((A))+stack_2((A))+stack_3((A)); - if ( stack_min((A))>stack_1((A)) ) stack_min((A))=stack_1((A)); - stack_max((A))=stack_1((A))+stack_2((A)); - if ( stack_max((A))<0 ) stack_max((A))=0; - } - } else if ( stack_3((A))<=0 ) { - if ( stack_2((A))>0 ) stack_max((A))=stack_1((A))+stack_2((A)); - else stack_max((A))=stack_1((A)); - stack_min((A))=stack_1((A))+stack_2((A))+stack_3((A)); - if ( stack_min((A))>0 ) stack_min((A))=0; - } else { - stack_max((A))=stack_1((A))+stack_2((A))+stack_3((A)); - if ( stack_max((A))<stack_1((A)) ) stack_max((A))=stack_1((A)); - stack_min((A))=stack_1((A))+stack_2((A)); - if ( stack_min((A))>0 ) stack_min((A))=0; - } - -@ It's convenient to keep the current values of $l$, $t_1$, and $t_2$ in -the integer form $2^l+2^lt_1$ and $2^l+2^lt_2$. The |cubic_intersection| -routine uses global variables |cur_t| and |cur_tt| for this purpose; -after successful completion, |cur_t| and |cur_tt| will contain |unity| -plus the |scaled| values of $t_1$ and~$t_2$. - -The values of |cur_t| and |cur_tt| will be set to zero if |cubic_intersection| -finds no intersection. The routine gives up and gives an approximate answer -if it has backtracked -more than 5000 times (otherwise there are cases where several minutes -of fruitless computation would be possible). - -@d max_patience 5000 - -@<Glob...@>= -integer cur_t;integer cur_tt; /* controls and results of |cubic_intersection| */ -integer time_to_go; /* this many backtracks before giving up */ -integer max_t; /* maximum of $2^{l+1}$ so far achieved */ - -@ The given cubics $B(w_0,w_1,w_2,w_3;t)$ and -$B(z_0,z_1,z_2,z_3;t)$ are specified in adjacent knot nodes |(p,mp_link(p))| -and |(pp,mp_link(pp))|, respectively. - -@c -static void mp_cubic_intersection (MP mp,pointer p, pointer pp) { - pointer q,qq; /* |mp_link(p)|, |mp_link(pp)| */ - mp->time_to_go=max_patience; mp->max_t=2; - @<Initialize for intersections at level zero@>; -CONTINUE: - while (1) { - if ( mp->delx-mp->tol<=stack_max(x_packet(mp->xy))-stack_min(u_packet(mp->uv))) - if ( mp->delx+mp->tol>=stack_min(x_packet(mp->xy))-stack_max(u_packet(mp->uv))) - if ( mp->dely-mp->tol<=stack_max(y_packet(mp->xy))-stack_min(v_packet(mp->uv))) - if ( mp->dely+mp->tol>=stack_min(y_packet(mp->xy))-stack_max(v_packet(mp->uv))) - { - if ( mp->cur_t>=mp->max_t ){ - if ( mp->max_t==two ) { /* we've done 17 bisections */ - mp->cur_t=halfp(mp->cur_t+1); - mp->cur_tt=halfp(mp->cur_tt+1); - return; - } - mp->max_t+=mp->max_t; mp->appr_t=mp->cur_t; mp->appr_tt=mp->cur_tt; - } - @<Subdivide for a new level of intersection@>; - goto CONTINUE; - } - if ( mp->time_to_go>0 ) { - decr(mp->time_to_go); - } else { - while ( mp->appr_t<unity ) { - mp->appr_t+=mp->appr_t; mp->appr_tt+=mp->appr_tt; - } - mp->cur_t=mp->appr_t; mp->cur_tt=mp->appr_tt; return; - } - @<Advance to the next pair |(cur_t,cur_tt)|@>; - } -} - -@ The following variables are global, although they are used only by -|cubic_intersection|, because it is necessary on some machines to -split |cubic_intersection| up into two procedures. - -@<Glob...@>= -integer delx;integer dely; /* the components of $\Delta=2^l(w_0-z_0)$ */ -integer tol; /* bound on the uncertainty in the overlap test */ -integer uv; -integer xy; /* pointers to the current packets of interest */ -integer three_l; /* |tol_step| times the bisection level */ -integer appr_t;integer appr_tt; /* best approximations known to the answers */ - -@ We shall assume that the coordinates are sufficiently non-extreme that -integer overflow will not occur. -@^overflow in arithmetic@> - -@<Initialize for intersections at level zero@>= -q=mp_link(p); qq=mp_link(pp); mp->bisect_ptr=int_packets; -u1r=mp_right_x(p)-mp_x_coord(p); u2r=mp_left_x(q)-mp_right_x(p); -u3r=mp_x_coord(q)-mp_left_x(q); set_min_max(ur_packet); -v1r=mp_right_y(p)-mp_y_coord(p); v2r=mp_left_y(q)-mp_right_y(p); -v3r=mp_y_coord(q)-mp_left_y(q); set_min_max(vr_packet); -x1r=mp_right_x(pp)-mp_x_coord(pp); x2r=mp_left_x(qq)-mp_right_x(pp); -x3r=mp_x_coord(qq)-mp_left_x(qq); set_min_max(xr_packet); -y1r=mp_right_y(pp)-mp_y_coord(pp); y2r=mp_left_y(qq)-mp_right_y(pp); -y3r=mp_y_coord(qq)-mp_left_y(qq); set_min_max(yr_packet); -mp->delx=mp_x_coord(p)-mp_x_coord(pp); mp->dely=mp_y_coord(p)-mp_y_coord(pp); -mp->tol=0; mp->uv=r_packets; mp->xy=r_packets; -mp->three_l=0; mp->cur_t=1; mp->cur_tt=1 - -@ @<Subdivide for a new level of intersection@>= -stack_dx=mp->delx; stack_dy=mp->dely; stack_tol=mp->tol; -stack_uv=mp->uv; stack_xy=mp->xy; -mp->bisect_ptr=mp->bisect_ptr+int_increment; -mp->cur_t+=mp->cur_t; mp->cur_tt+=mp->cur_tt; -u1l=stack_1(u_packet(mp->uv)); u3r=stack_3(u_packet(mp->uv)); -u2l=half(u1l+stack_2(u_packet(mp->uv))); -u2r=half(u3r+stack_2(u_packet(mp->uv))); -u3l=half(u2l+u2r); u1r=u3l; -set_min_max(ul_packet); set_min_max(ur_packet); -v1l=stack_1(v_packet(mp->uv)); v3r=stack_3(v_packet(mp->uv)); -v2l=half(v1l+stack_2(v_packet(mp->uv))); -v2r=half(v3r+stack_2(v_packet(mp->uv))); -v3l=half(v2l+v2r); v1r=v3l; -set_min_max(vl_packet); set_min_max(vr_packet); -x1l=stack_1(x_packet(mp->xy)); x3r=stack_3(x_packet(mp->xy)); -x2l=half(x1l+stack_2(x_packet(mp->xy))); -x2r=half(x3r+stack_2(x_packet(mp->xy))); -x3l=half(x2l+x2r); x1r=x3l; -set_min_max(xl_packet); set_min_max(xr_packet); -y1l=stack_1(y_packet(mp->xy)); y3r=stack_3(y_packet(mp->xy)); -y2l=half(y1l+stack_2(y_packet(mp->xy))); -y2r=half(y3r+stack_2(y_packet(mp->xy))); -y3l=half(y2l+y2r); y1r=y3l; -set_min_max(yl_packet); set_min_max(yr_packet); -mp->uv=l_packets; mp->xy=l_packets; -mp->delx+=mp->delx; mp->dely+=mp->dely; -mp->tol=mp->tol-mp->three_l+mp->tol_step; -mp->tol+=mp->tol; mp->three_l=mp->three_l+mp->tol_step - -@ @<Advance to the next pair |(cur_t,cur_tt)|@>= -NOT_FOUND: -if ( odd(mp->cur_tt) ) { - if ( odd(mp->cur_t) ) { - @<Descend to the previous level and |goto not_found|@>; - } else { - incr(mp->cur_t); - mp->delx=mp->delx+stack_1(u_packet(mp->uv))+stack_2(u_packet(mp->uv)) - +stack_3(u_packet(mp->uv)); - mp->dely=mp->dely+stack_1(v_packet(mp->uv))+stack_2(v_packet(mp->uv)) - +stack_3(v_packet(mp->uv)); - mp->uv=mp->uv+int_packets; /* switch from |l_packets| to |r_packets| */ - decr(mp->cur_tt); mp->xy=mp->xy-int_packets; - /* switch from |r_packets| to |l_packets| */ - mp->delx=mp->delx+stack_1(x_packet(mp->xy))+stack_2(x_packet(mp->xy)) - +stack_3(x_packet(mp->xy)); - mp->dely=mp->dely+stack_1(y_packet(mp->xy))+stack_2(y_packet(mp->xy)) - +stack_3(y_packet(mp->xy)); - } -} else { - incr(mp->cur_tt); mp->tol=mp->tol+mp->three_l; - mp->delx=mp->delx-stack_1(x_packet(mp->xy))-stack_2(x_packet(mp->xy)) - -stack_3(x_packet(mp->xy)); - mp->dely=mp->dely-stack_1(y_packet(mp->xy))-stack_2(y_packet(mp->xy)) - -stack_3(y_packet(mp->xy)); - mp->xy=mp->xy+int_packets; /* switch from |l_packets| to |r_packets| */ -} - -@ @<Descend to the previous level...@>= -{ - mp->cur_t=halfp(mp->cur_t); mp->cur_tt=halfp(mp->cur_tt); - if ( mp->cur_t==0 ) return; - mp->bisect_ptr=mp->bisect_ptr-int_increment; - mp->three_l=mp->three_l-mp->tol_step; - mp->delx=stack_dx; mp->dely=stack_dy; mp->tol=stack_tol; - mp->uv=stack_uv; mp->xy=stack_xy; - goto NOT_FOUND; -} - -@ The |path_intersection| procedure is much simpler. -It invokes |cubic_intersection| in lexicographic order until finding a -pair of cubics that intersect. The final intersection times are placed in -|cur_t| and~|cur_tt|. - -@c -static void mp_path_intersection (MP mp,pointer h, pointer hh) { - pointer p,pp; /* link registers that traverse the given paths */ - integer n,nn; /* integer parts of intersection times, minus |unity| */ - @<Change one-point paths into dead cycles@>; - mp->tol_step=0; - do { - n=-unity; p=h; - do { - if ( mp_right_type(p)!=mp_endpoint ) { - nn=-unity; pp=hh; - do { - if ( mp_right_type(pp)!=mp_endpoint ) { - mp_cubic_intersection(mp, p,pp); - if ( mp->cur_t>0 ) { - mp->cur_t=mp->cur_t+n; mp->cur_tt=mp->cur_tt+nn; - return; - } - } - nn=nn+unity; pp=mp_link(pp); - } while (pp!=hh); - } - n=n+unity; p=mp_link(p); - } while (p!=h); - mp->tol_step=mp->tol_step+3; - } while (mp->tol_step<=3); - mp->cur_t=-unity; mp->cur_tt=-unity; -} - -@ @<Change one-point paths...@>= -if ( mp_right_type(h)==mp_endpoint ) { - mp_right_x(h)=mp_x_coord(h); mp_left_x(h)=mp_x_coord(h); - mp_right_y(h)=mp_y_coord(h); mp_left_y(h)=mp_y_coord(h); mp_right_type(h)=mp_explicit; -} -if ( mp_right_type(hh)==mp_endpoint ) { - mp_right_x(hh)=mp_x_coord(hh); mp_left_x(hh)=mp_x_coord(hh); - mp_right_y(hh)=mp_y_coord(hh); mp_left_y(hh)=mp_y_coord(hh); mp_right_type(hh)=mp_explicit; -} - -@* \[24] Dynamic linear equations. -\MP\ users define variables implicitly by stating equations that should be -satisfied; the computer is supposed to be smart enough to solve those equations. -And indeed, the computer tries valiantly to do so, by distinguishing five -different types of numeric values: - -\smallskip\hang -|type(p)=mp_known| is the nice case, when |value(p)| is the |scaled| value -of the variable whose address is~|p|. - -\smallskip\hang -|type(p)=mp_dependent| means that |value(p)| is not present, but |dep_list(p)| -points to a {\sl dependency list\/} that expresses the value of variable~|p| -as a |scaled| number plus a sum of independent variables with |fraction| -coefficients. - -\smallskip\hang -|type(p)=mp_independent| means that |value(p)=64s+m|, where |s>0| is a ``serial -number'' reflecting the time this variable was first used in an equation; -also |0<=m<64|, and each dependent variable -that refers to this one is actually referring to the future value of -this variable times~$2^m$. (Usually |m=0|, but higher degrees of -scaling are sometimes needed to keep the coefficients in dependency lists -from getting too large. The value of~|m| will always be even.) - -\smallskip\hang -|type(p)=mp_numeric_type| means that variable |p| hasn't appeared in an -equation before, but it has been explicitly declared to be numeric. - -\smallskip\hang -|type(p)=undefined| means that variable |p| hasn't appeared before. - -\smallskip\noindent -We have actually discussed these five types in the reverse order of their -history during a computation: Once |known|, a variable never again -becomes |dependent|; once |dependent|, it almost never again becomes -|mp_independent|; once |mp_independent|, it never again becomes |mp_numeric_type|; -and once |mp_numeric_type|, it never again becomes |undefined| (except -of course when the user specifically decides to scrap the old value -and start again). A backward step may, however, take place: Sometimes -a |dependent| variable becomes |mp_independent| again, when one of the -independent variables it depends on is reverting to |undefined|. - - -The next patch detects overflow of independent-variable serial -numbers. Diagnosed and patched by Thorsten Dahlheimer. - -@d s_scale 64 /* the serial numbers are multiplied by this factor */ -@d new_indep(A) /* create a new independent variable */ - { if ( mp->serial_no>el_gordo-s_scale ) - mp_fatal_error(mp, "variable instance identifiers exhausted"); - mp_type((A))=mp_independent; mp->serial_no=mp->serial_no+s_scale; - value((A))=mp->serial_no; - } - -@<Glob...@>= -integer serial_no; /* the most recent serial number, times |s_scale| */ - -@ @<Make variable |q+s| newly independent@>=new_indep(q+s) - -@ But how are dependency lists represented? It's simple: The linear combination -$\alpha_1v_1+\cdots+\alpha_kv_k+\beta$ appears in |k+1| value nodes. If -|q=dep_list(p)| points to this list, and if |k>0|, then |value(q)= -@t$\alpha_1$@>| (which is a |fraction|); |mp_info(q)| points to the location -of $\alpha_1$; and |mp_link(p)| points to the dependency list -$\alpha_2v_2+\cdots+\alpha_kv_k+\beta$. On the other hand if |k=0|, -then |value(q)=@t$\beta$@>| (which is |scaled|) and |mp_info(q)=null|. -The independent variables $v_1$, \dots,~$v_k$ have been sorted so that -they appear in decreasing order of their |value| fields (i.e., of -their serial numbers). \ (It is convenient to use decreasing order, -since |value(null)=0|. If the independent variables were not sorted by -serial number but by some other criterion, such as their location in |mem|, -the equation-solving mechanism would be too system-dependent, because -the ordering can affect the computed results.) - -The |link| field in the node that contains the constant term $\beta$ is -called the {\sl final link\/} of the dependency list. \MP\ maintains -a doubly-linked master list of all dependency lists, in terms of a permanently -allocated node -in |mem| called |dep_head|. If there are no dependencies, we have -|mp_link(dep_head)=dep_head| and |prev_dep(dep_head)=dep_head|; -otherwise |mp_link(dep_head)| points to the first dependent variable, say~|p|, -and |prev_dep(p)=dep_head|. We have |type(p)=mp_dependent|, and |dep_list(p)| -points to its dependency list. If the final link of that dependency list -occurs in location~|q|, then |mp_link(q)| points to the next dependent -variable (say~|r|); and we have |prev_dep(r)=q|, etc. - -@d dep_list(A) mp_link(value_loc((A))) - /* half of the |value| field in a |dependent| variable */ -@d prev_dep(A) mp_info(value_loc((A))) - /* the other half; makes a doubly linked list */ -@d dep_node_size 2 /* the number of words per dependency node */ - -@<Initialize table entries...@>= mp->serial_no=0; -mp_link(dep_head)=dep_head; prev_dep(dep_head)=dep_head; -mp_info(dep_head)=null; dep_list(dep_head)=null; - -@ Actually the description above contains a little white lie. There's -another kind of variable called |mp_proto_dependent|, which is -just like a |dependent| one except that the $\alpha$ coefficients -in its dependency list are |scaled| instead of being fractions. -Proto-dependency lists are mixed with dependency lists in the -nodes reachable from |dep_head|. - -@ Here is a procedure that prints a dependency list in symbolic form. -The second parameter should be either |dependent| or |mp_proto_dependent|, -to indicate the scaling of the coefficients. - -@<Declarations@>= -static void mp_print_dependency (MP mp,pointer p, quarterword t); - -@ @c -void mp_print_dependency (MP mp,pointer p, quarterword t) { - integer v; /* a coefficient */ - pointer pp,q; /* for list manipulation */ - pp=p; - while (true) { - v=abs(value(p)); q=mp_info(p); - if ( q==null ) { /* the constant term */ - if ( (v!=0)||(p==pp) ) { - if ( value(p)>0 ) if ( p!=pp ) mp_print_char(mp, xord('+')); - mp_print_scaled(mp, value(p)); - } - return; - } - @<Print the coefficient, unless it's $\pm1.0$@>; - if ( mp_type(q)!=mp_independent ) mp_confusion(mp, "dep"); -@:this can't happen dep}{\quad dep@> - mp_print_variable_name(mp, q); v=value(q) % s_scale; - while ( v>0 ) { mp_print(mp, "*4"); v=v-2; } - p=mp_link(p); - } -} - -@ @<Print the coefficient, unless it's $\pm1.0$@>= -if ( value(p)<0 ) mp_print_char(mp, xord('-')); -else if ( p!=pp ) mp_print_char(mp, xord('+')); -if ( t==mp_dependent ) v=mp_round_fraction(mp, v); -if ( v!=unity ) mp_print_scaled(mp, v) - -@ The maximum absolute value of a coefficient in a given dependency list -is returned by the following simple function. - -@c -static fraction mp_max_coef (MP mp,pointer p) { - fraction x; /* the maximum so far */ - x=0; - while ( mp_info(p)!=null ) { - if ( abs(value(p))>x ) x=abs(value(p)); - p=mp_link(p); - } - return x; -} - -@ One of the main operations needed on dependency lists is to add a multiple -of one list to the other; we call this |p_plus_fq|, where |p| and~|q| point -to dependency lists and |f| is a fraction. - -If the coefficient of any independent variable becomes |coef_bound| or -more, in absolute value, this procedure changes the type of that variable -to `|independent_needing_fix|', and sets the global variable |fix_needed| -to~|true|. The value of $|coef_bound|=\mu$ is chosen so that -$\mu^2+\mu<8$; this means that the numbers we deal with won't -get too large. (Instead of the ``optimum'' $\mu=(\sqrt{33}-1)/2\approx -2.3723$, the safer value 7/3 is taken as the threshold.) - -The changes mentioned in the preceding paragraph are actually done only if -the global variable |watch_coefs| is |true|. But it usually is; in fact, -it is |false| only when \MP\ is making a dependency list that will soon -be equated to zero. - -Several procedures that act on dependency lists, including |p_plus_fq|, -set the global variable |dep_final| to the final (constant term) node of -the dependency list that they produce. - -@d coef_bound 04525252525 /* |fraction| approximation to 7/3 */ -@d independent_needing_fix 0 - -@<Glob...@>= -boolean fix_needed; /* does at least one |independent| variable need scaling? */ -boolean watch_coefs; /* should we scale coefficients that exceed |coef_bound|? */ -pointer dep_final; /* location of the constant term and final link */ - -@ @<Set init...@>= -mp->fix_needed=false; mp->watch_coefs=true; - -@ The |p_plus_fq| procedure has a fourth parameter, |t|, that should be -set to |mp_proto_dependent| if |p| is a proto-dependency list. In this -case |f| will be |scaled|, not a |fraction|. Similarly, the fifth parameter~|tt| -should be |mp_proto_dependent| if |q| is a proto-dependency list. - -List |q| is unchanged by the operation; but list |p| is totally destroyed. - -The final link of the dependency list or proto-dependency list returned -by |p_plus_fq| is the same as the original final link of~|p|. Indeed, the -constant term of the result will be located in the same |mem| location -as the original constant term of~|p|. - -Coefficients of the result are assumed to be zero if they are less than -a certain threshold. This compensates for inevitable rounding errors, -and tends to make more variables `|known|'. The threshold is approximately -$10^{-5}$ in the case of normal dependency lists, $10^{-4}$ for -proto-dependencies. - -@d fraction_threshold 2685 /* a |fraction| coefficient less than this is zeroed */ -@d half_fraction_threshold 1342 /* half of |fraction_threshold| */ -@d scaled_threshold 8 /* a |scaled| coefficient less than this is zeroed */ -@d half_scaled_threshold 4 /* half of |scaled_threshold| */ - -@<Declarations@>= -static pointer mp_p_plus_fq ( MP mp, pointer p, integer f, - pointer q, quarterword t, quarterword tt) ; - -@ @c -pointer mp_p_plus_fq ( MP mp, pointer p, integer f, - pointer q, quarterword t, quarterword tt) { - pointer pp,qq; /* |mp_info(p)| and |mp_info(q)|, respectively */ - pointer r,s; /* for list manipulation */ - integer threshold; /* defines a neighborhood of zero */ - integer v; /* temporary register */ - if ( t==mp_dependent ) threshold=fraction_threshold; - else threshold=scaled_threshold; - r=temp_head; pp=mp_info(p); qq=mp_info(q); - while (1) { - if ( pp==qq ) { - if ( pp==null ) { - break; - } else { - @<Contribute a term from |p|, plus |f| times the - corresponding term from |q|@> - } - } else if ( value(pp)<value(qq) ) { - @<Contribute a term from |q|, multiplied by~|f|@> - } else { - mp_link(r)=p; r=p; p=mp_link(p); pp=mp_info(p); - } - } - if ( t==mp_dependent ) - value(p)=mp_slow_add(mp, value(p),mp_take_fraction(mp, value(q),f)); - else - value(p)=mp_slow_add(mp, value(p),mp_take_scaled(mp, value(q),f)); - mp_link(r)=p; mp->dep_final=p; - return mp_link(temp_head); -} - -@ @<Contribute a term from |p|, plus |f|...@>= -{ - if ( tt==mp_dependent ) v=value(p)+mp_take_fraction(mp, f,value(q)); - else v=value(p)+mp_take_scaled(mp, f,value(q)); - value(p)=v; s=p; p=mp_link(p); - if ( abs(v)<threshold ) { - mp_free_node(mp, s,dep_node_size); - } else { - if ( (abs(v)>=coef_bound) && mp->watch_coefs ) { - mp_type(qq)=independent_needing_fix; mp->fix_needed=true; - } - mp_link(r)=s; r=s; - }; - pp=mp_info(p); q=mp_link(q); qq=mp_info(q); -} - -@ @<Contribute a term from |q|, multiplied by~|f|@>= -{ - if ( tt==mp_dependent ) v=mp_take_fraction(mp, f,value(q)); - else v=mp_take_scaled(mp, f,value(q)); - if ( abs(v)>halfp(threshold) ) { - s=mp_get_node(mp, dep_node_size); mp_info(s)=qq; value(s)=v; - if ( (abs(v)>=coef_bound) && mp->watch_coefs ) { - mp_type(qq)=independent_needing_fix; mp->fix_needed=true; - } - mp_link(r)=s; r=s; - } - q=mp_link(q); qq=mp_info(q); -} - -@ It is convenient to have another subroutine for the special case -of |p_plus_fq| when |f=1.0|. In this routine lists |p| and |q| are -both of the same type~|t| (either |dependent| or |mp_proto_dependent|). - -@c -static pointer mp_p_plus_q (MP mp,pointer p, pointer q, quarterword t) { - pointer pp,qq; /* |mp_info(p)| and |mp_info(q)|, respectively */ - pointer r,s; /* for list manipulation */ - integer threshold; /* defines a neighborhood of zero */ - integer v; /* temporary register */ - if ( t==mp_dependent ) threshold=fraction_threshold; - else threshold=scaled_threshold; - r=temp_head; pp=mp_info(p); qq=mp_info(q); - while (1) { - if ( pp==qq ) { - if ( pp==null ) { - break; - } else { - @<Contribute a term from |p|, plus the - corresponding term from |q|@> - } - } else { - if ( value(pp)<value(qq) ) { - s=mp_get_node(mp, dep_node_size); mp_info(s)=qq; value(s)=value(q); - q=mp_link(q); qq=mp_info(q); mp_link(r)=s; r=s; - } else { - mp_link(r)=p; r=p; p=mp_link(p); pp=mp_info(p); - } - } - } - value(p)=mp_slow_add(mp, value(p),value(q)); - mp_link(r)=p; mp->dep_final=p; - return mp_link(temp_head); -} - -@ @<Contribute a term from |p|, plus the...@>= -{ - v=value(p)+value(q); - value(p)=v; s=p; p=mp_link(p); pp=mp_info(p); - if ( abs(v)<threshold ) { - mp_free_node(mp, s,dep_node_size); - } else { - if ( (abs(v)>=coef_bound ) && mp->watch_coefs ) { - mp_type(qq)=independent_needing_fix; mp->fix_needed=true; - } - mp_link(r)=s; r=s; - } - q=mp_link(q); qq=mp_info(q); -} - -@ A somewhat simpler routine will multiply a dependency list -by a given constant~|v|. The constant is either a |fraction| less than -|fraction_one|, or it is |scaled|. In the latter case we might be forced to -convert a dependency list to a proto-dependency list. -Parameters |t0| and |t1| are the list types before and after; -they should agree unless |t0=mp_dependent| and |t1=mp_proto_dependent| -and |v_is_scaled=true|. - -@c -static pointer mp_p_times_v (MP mp,pointer p, integer v, quarterword t0, - quarterword t1, boolean v_is_scaled) { - pointer r,s; /* for list manipulation */ - integer w; /* tentative coefficient */ - integer threshold; - boolean scaling_down; - if ( t0!=t1 ) scaling_down=true; else scaling_down=(!v_is_scaled); - if ( t1==mp_dependent ) threshold=half_fraction_threshold; - else threshold=half_scaled_threshold; - r=temp_head; - while ( mp_info(p)!=null ) { - if ( scaling_down ) w=mp_take_fraction(mp, v,value(p)); - else w=mp_take_scaled(mp, v,value(p)); - if ( abs(w)<=threshold ) { - s=mp_link(p); mp_free_node(mp, p,dep_node_size); p=s; - } else { - if ( abs(w)>=coef_bound ) { - mp->fix_needed=true; mp_type(mp_info(p))=independent_needing_fix; - } - mp_link(r)=p; r=p; value(p)=w; p=mp_link(p); - } - } - mp_link(r)=p; - if ( v_is_scaled ) value(p)=mp_take_scaled(mp, value(p),v); - else value(p)=mp_take_fraction(mp, value(p),v); - return mp_link(temp_head); -} - -@ Similarly, we sometimes need to divide a dependency list -by a given |scaled| constant. - -@<Declarations@>= -static pointer mp_p_over_v (MP mp,pointer p, scaled v, quarterword - t0, quarterword t1) ; - -@ @c -pointer mp_p_over_v (MP mp,pointer p, scaled v, quarterword - t0, quarterword t1) { - pointer r,s; /* for list manipulation */ - integer w; /* tentative coefficient */ - integer threshold; - boolean scaling_down; - if ( t0!=t1 ) scaling_down=true; else scaling_down=false; - if ( t1==mp_dependent ) threshold=half_fraction_threshold; - else threshold=half_scaled_threshold; - r=temp_head; - while ( mp_info( p)!=null ) { - if ( scaling_down ) { - if ( abs(v)<02000000 ) w=mp_make_scaled(mp, value(p),v*010000); - else w=mp_make_scaled(mp, mp_round_fraction(mp, value(p)),v); - } else { - w=mp_make_scaled(mp, value(p),v); - } - if ( abs(w)<=threshold ) { - s=mp_link(p); mp_free_node(mp, p,dep_node_size); p=s; - } else { - if ( abs(w)>=coef_bound ) { - mp->fix_needed=true; mp_type(mp_info(p))=independent_needing_fix; - } - mp_link(r)=p; r=p; value(p)=w; p=mp_link(p); - } - } - mp_link(r)=p; value(p)=mp_make_scaled(mp, value(p),v); - return mp_link(temp_head); -} - -@ Here's another utility routine for dependency lists. When an independent -variable becomes dependent, we want to remove it from all existing -dependencies. The |p_with_x_becoming_q| function computes the -dependency list of~|p| after variable~|x| has been replaced by~|q|. - -This procedure has basically the same calling conventions as |p_plus_fq|: -List~|q| is unchanged; list~|p| is destroyed; the constant node and the -final link are inherited from~|p|; and the fourth parameter tells whether -or not |p| is |mp_proto_dependent|. However, the global variable |dep_final| -is not altered if |x| does not occur in list~|p|. - -@c -static pointer mp_p_with_x_becoming_q (MP mp,pointer p, - pointer x, pointer q, quarterword t) { - pointer r,s; /* for list manipulation */ - integer v; /* coefficient of |x| */ - integer sx; /* serial number of |x| */ - s=p; r=temp_head; sx=value(x); - while ( value(mp_info(s))>sx ) { r=s; s=mp_link(s); }; - if ( mp_info(s)!=x ) { - return p; - } else { - mp_link(temp_head)=p; mp_link(r)=mp_link(s); v=value(s); - mp_free_node(mp, s,dep_node_size); - return mp_p_plus_fq(mp, mp_link(temp_head),v,q,t,mp_dependent); - } -} - -@ Here's a simple procedure that reports an error when a variable -has just received a known value that's out of the required range. - -@<Declarations@>= -static void mp_val_too_big (MP mp,scaled x) ; - -@ @c void mp_val_too_big (MP mp,scaled x) { - if ( mp->internal[mp_warning_check]>0 ) { - print_err("Value is too large ("); mp_print_scaled(mp, x); mp_print_char(mp, xord(')')); -@.Value is too large@> - help4("The equation I just processed has given some variable", - "a value of 4096 or more. Continue and I'll try to cope", - "with that big value; but it might be dangerous.", - "(Set warningcheck:=0 to suppress this message.)"); - mp_error(mp); - } -} - -@ When a dependent variable becomes known, the following routine -removes its dependency list. Here |p| points to the variable, and -|q| points to the dependency list (which is one node long). - -@<Declarations@>= -static void mp_make_known (MP mp,pointer p, pointer q) ; - -@ @c void mp_make_known (MP mp,pointer p, pointer q) { - int t; /* the previous type */ - prev_dep(mp_link(q))=prev_dep(p); - mp_link(prev_dep(p))=mp_link(q); t=mp_type(p); - mp_type(p)=mp_known; value(p)=value(q); mp_free_node(mp, q,dep_node_size); - if ( abs(value(p))>=fraction_one ) mp_val_too_big(mp, value(p)); - if (( mp->internal[mp_tracing_equations]>0) && mp_interesting(mp, p) ) { - mp_begin_diagnostic(mp); mp_print_nl(mp, "#### "); -@:]]]\#\#\#\#_}{\.{\#\#\#\#}@> - mp_print_variable_name(mp, p); - mp_print_char(mp, xord('=')); mp_print_scaled(mp, value(p)); - mp_end_diagnostic(mp, false); - } - if (( mp->cur_exp==p ) && mp->cur_type==t ) { - mp->cur_type=mp_known; mp->cur_exp=value(p); - mp_free_node(mp, p,value_node_size); - } -} - -@ The |fix_dependencies| routine is called into action when |fix_needed| -has been triggered. The program keeps a list~|s| of independent variables -whose coefficients must be divided by~4. - -In unusual cases, this fixup process might reduce one or more coefficients -to zero, so that a variable will become known more or less by default. - -@<Declarations@>= -static void mp_fix_dependencies (MP mp); - -@ @c -static void mp_fix_dependencies (MP mp) { - pointer p,q,r,s,t; /* list manipulation registers */ - pointer x; /* an independent variable */ - r=mp_link(dep_head); s=null; - while ( r!=dep_head ){ - t=r; - @<Run through the dependency list for variable |t|, fixing - all nodes, and ending with final link~|q|@>; - r=mp_link(q); - if ( q==dep_list(t) ) mp_make_known(mp, t,q); - } - while ( s!=null ) { - p=mp_link(s); x=mp_info(s); free_avail(s); s=p; - mp_type(x)=mp_independent; value(x)=value(x)+2; - } - mp->fix_needed=false; -} - -@ @d independent_being_fixed 1 /* this variable already appears in |s| */ - -@<Run through the dependency list for variable |t|...@>= -r=value_loc(t); /* |mp_link(r)=dep_list(t)| */ -while (1) { - q=mp_link(r); x=mp_info(q); - if ( x==null ) break; - if ( mp_type(x)<=independent_being_fixed ) { - if ( mp_type(x)<independent_being_fixed ) { - p=mp_get_avail(mp); mp_link(p)=s; s=p; - mp_info(s)=x; mp_type(x)=independent_being_fixed; - } - value(q)=value(q) / 4; - if ( value(q)==0 ) { - mp_link(r)=mp_link(q); mp_free_node(mp, q,dep_node_size); q=r; - } - } - r=q; -} - - -@ The |new_dep| routine installs a dependency list~|p| into the value node~|q|, -linking it into the list of all known dependencies. We assume that -|dep_final| points to the final node of list~|p|. - -@c -static void mp_new_dep (MP mp,pointer q, pointer p) { - pointer r; /* what used to be the first dependency */ - dep_list(q)=p; prev_dep(q)=dep_head; - r=mp_link(dep_head); mp_link(mp->dep_final)=r; prev_dep(r)=mp->dep_final; - mp_link(dep_head)=q; -} - -@ Here is one of the ways a dependency list gets started. -The |const_dependency| routine produces a list that has nothing but -a constant term. - -@c static pointer mp_const_dependency (MP mp, scaled v) { - mp->dep_final=mp_get_node(mp, dep_node_size); - value(mp->dep_final)=v; mp_info(mp->dep_final)=null; - return mp->dep_final; -} - -@ And here's a more interesting way to start a dependency list from scratch: -The parameter to |single_dependency| is the location of an -independent variable~|x|, and the result is the simple dependency list -`|x+0|'. - -In the unlikely event that the given independent variable has been doubled so -often that we can't refer to it with a nonzero coefficient, -|single_dependency| returns the simple list `0'. This case can be -recognized by testing that the returned list pointer is equal to -|dep_final|. - -@c -static pointer mp_single_dependency (MP mp,pointer p) { - pointer q; /* the new dependency list */ - integer m; /* the number of doublings */ - m=value(p) % s_scale; - if ( m>28 ) { - return mp_const_dependency(mp, 0); - } else { - q=mp_get_node(mp, dep_node_size); - value(q)=(integer)two_to_the(28-m); mp_info(q)=p; - mp_link(q)=mp_const_dependency(mp, 0); - return q; - } -} - -@ We sometimes need to make an exact copy of a dependency list. - -@c -static pointer mp_copy_dep_list (MP mp,pointer p) { - pointer q; /* the new dependency list */ - q=mp_get_node(mp, dep_node_size); mp->dep_final=q; - while (1) { - mp_info(mp->dep_final)=mp_info(p); value(mp->dep_final)=value(p); - if ( mp_info(mp->dep_final)==null ) break; - mp_link(mp->dep_final)=mp_get_node(mp, dep_node_size); - mp->dep_final=mp_link(mp->dep_final); p=mp_link(p); - } - return q; -} - -@ But how do variables normally become known? Ah, now we get to the heart of the -equation-solving mechanism. The |linear_eq| procedure is given a |dependent| -or |mp_proto_dependent| list,~|p|, in which at least one independent variable -appears. It equates this list to zero, by choosing an independent variable -with the largest coefficient and making it dependent on the others. The -newly dependent variable is eliminated from all current dependencies, -thereby possibly making other dependent variables known. - -The given list |p| is, of course, totally destroyed by all this processing. - -@c -static void mp_linear_eq (MP mp, pointer p, quarterword t) { - pointer q,r,s; /* for link manipulation */ - pointer x; /* the variable that loses its independence */ - integer n; /* the number of times |x| had been halved */ - integer v; /* the coefficient of |x| in list |p| */ - pointer prev_r; /* lags one step behind |r| */ - pointer final_node; /* the constant term of the new dependency list */ - integer w; /* a tentative coefficient */ - @<Find a node |q| in list |p| whose coefficient |v| is largest@>; - x=mp_info(q); n=value(x) % s_scale; - @<Divide list |p| by |-v|, removing node |q|@>; - if ( mp->internal[mp_tracing_equations]>0 ) { - @<Display the new dependency@>; - } - @<Simplify all existing dependencies by substituting for |x|@>; - @<Change variable |x| from |independent| to |dependent| or |known|@>; - if ( mp->fix_needed ) mp_fix_dependencies(mp); -} - -@ @<Find a node |q| in list |p| whose coefficient |v| is largest@>= -q=p; r=mp_link(p); v=value(q); -while ( mp_info(r)!=null ) { - if ( abs(value(r))>abs(v) ) { q=r; v=value(r); }; - r=mp_link(r); -} - -@ Here we want to change the coefficients from |scaled| to |fraction|, -except in the constant term. In the common case of a trivial equation -like `\.{x=3.14}', we will have |v=-fraction_one|, |q=p|, and |t=mp_dependent|. - -@<Divide list |p| by |-v|, removing node |q|@>= -s=temp_head; mp_link(s)=p; r=p; -do { - if ( r==q ) { - mp_link(s)=mp_link(r); mp_free_node(mp, r,dep_node_size); - } else { - w=mp_make_fraction(mp, value(r),v); - if ( abs(w)<=half_fraction_threshold ) { - mp_link(s)=mp_link(r); mp_free_node(mp, r,dep_node_size); - } else { - value(r)=-w; s=r; - } - } - r=mp_link(s); -} while (mp_info(r)!=null); -if ( t==mp_proto_dependent ) { - value(r)=-mp_make_scaled(mp, value(r),v); -} else if ( v!=-fraction_one ) { - value(r)=-mp_make_fraction(mp, value(r),v); -} -final_node=r; p=mp_link(temp_head) - -@ @<Display the new dependency@>= -if ( mp_interesting(mp, x) ) { - mp_begin_diagnostic(mp); mp_print_nl(mp, "## "); - mp_print_variable_name(mp, x); -@:]]]\#\#_}{\.{\#\#}@> - w=n; - while ( w>0 ) { mp_print(mp, "*4"); w=w-2; }; - mp_print_char(mp, xord('=')); mp_print_dependency(mp, p,mp_dependent); - mp_end_diagnostic(mp, false); -} - -@ @<Simplify all existing dependencies by substituting for |x|@>= -prev_r=dep_head; r=mp_link(dep_head); -while ( r!=dep_head ) { - s=dep_list(r); q=mp_p_with_x_becoming_q(mp, s,x,p,mp_type(r)); - if ( mp_info(q)==null ) { - mp_make_known(mp, r,q); - } else { - dep_list(r)=q; - do { q=mp_link(q); } while (mp_info(q)!=null); - prev_r=q; - } - r=mp_link(prev_r); -} - -@ @<Change variable |x| from |independent| to |dependent| or |known|@>= -if ( n>0 ) @<Divide list |p| by $2^n$@>; -if ( mp_info(p)==null ) { - mp_type(x)=mp_known; - value(x)=value(p); - if ( abs(value(x))>=fraction_one ) mp_val_too_big(mp, value(x)); - mp_free_node(mp, p,dep_node_size); - if ( mp->cur_exp==x ) if ( mp->cur_type==mp_independent ) { - mp->cur_exp=value(x); mp->cur_type=mp_known; - mp_free_node(mp, x,value_node_size); - } -} else { - mp_type(x)=mp_dependent; mp->dep_final=final_node; mp_new_dep(mp, x,p); - if ( mp->cur_exp==x ) if ( mp->cur_type==mp_independent ) mp->cur_type=mp_dependent; -} - -@ @<Divide list |p| by $2^n$@>= -{ - s=temp_head; mp_link(temp_head)=p; r=p; - do { - if ( n>30 ) w=0; - else w=value(r) / two_to_the(n); - if ( (abs(w)<=half_fraction_threshold)&&(mp_info(r)!=null) ) { - mp_link(s)=mp_link(r); - mp_free_node(mp, r,dep_node_size); - } else { - value(r)=w; s=r; - } - r=mp_link(s); - } while (mp_info(s)!=null); - p=mp_link(temp_head); -} - -@ The |check_mem| procedure, which is used only when \MP\ is being -debugged, makes sure that the current dependency lists are well formed. - -@<Check the list of linear dependencies@>= -q=dep_head; p=mp_link(q); -while ( p!=dep_head ) { - if ( prev_dep(p)!=q ) { - mp_print_nl(mp, "Bad PREVDEP at "); mp_print_int(mp, p); -@.Bad PREVDEP...@> - } - p=dep_list(p); - while (1) { - r=mp_info(p); q=p; p=mp_link(q); - if ( r==null ) break; - if ( value(mp_info(p))>=value(r) ) { - mp_print_nl(mp, "Out of order at "); mp_print_int(mp, p); -@.Out of order...@> - } - } -} - -@* \[25] Dynamic nonlinear equations. -Variables of numeric type are maintained by the general scheme of -independent, dependent, and known values that we have just studied; -and the components of pair and transform variables are handled in the -same way. But \MP\ also has five other types of values: \&{boolean}, -\&{string}, \&{pen}, \&{path}, and \&{picture}; what about them? - -Equations are allowed between nonlinear quantities, but only in a -simple form. Two variables that haven't yet been assigned values are -either equal to each other, or they're not. - -Before a boolean variable has received a value, its type is |mp_unknown_boolean|; -similarly, there are variables whose type is |mp_unknown_string|, |mp_unknown_pen|, -|mp_unknown_path|, and |mp_unknown_picture|. In such cases the value is either -|null| (which means that no other variables are equivalent to this one), or -it points to another variable of the same undefined type. The pointers in the -latter case form a cycle of nodes, which we shall call a ``ring.'' -Rings of undefined variables may include capsules, which arise as -intermediate results within expressions or as \&{expr} parameters to macros. - -When one member of a ring receives a value, the same value is given to -all the other members. In the case of paths and pictures, this implies -making separate copies of a potentially large data structure; users should -restrain their enthusiasm for such generality, unless they have lots and -lots of memory space. - -@ The following procedure is called when a capsule node is being -added to a ring (e.g., when an unknown variable is mentioned in an expression). - -@c -static pointer mp_new_ring_entry (MP mp,pointer p) { - pointer q; /* the new capsule node */ - q=mp_get_node(mp, value_node_size); mp_name_type(q)=mp_capsule; - mp_type(q)=mp_type(p); - if ( value(p)==null ) value(q)=p; else value(q)=value(p); - value(p)=q; - return q; -} - -@ Conversely, we might delete a capsule or a variable before it becomes known. -The following procedure simply detaches a quantity from its ring, -without recycling the storage. - -@<Declarations@>= -static void mp_ring_delete (MP mp,pointer p); - -@ @c -void mp_ring_delete (MP mp,pointer p) { - pointer q; - q=value(p); - if ( q!=null ) if ( q!=p ){ - while ( value(q)!=p ) q=value(q); - value(q)=value(p); - } -} - -@ Eventually there might be an equation that assigns values to all of the -variables in a ring. The |nonlinear_eq| subroutine does the necessary -propagation of values. - -If the parameter |flush_p| is |true|, node |p| itself needn't receive a -value, it will soon be recycled. - -@c -static void mp_nonlinear_eq (MP mp,integer v, pointer p, boolean flush_p) { - quarterword t; /* the type of ring |p| */ - pointer q,r; /* link manipulation registers */ - t=mp_type(p)-unknown_tag; q=value(p); - if ( flush_p ) mp_type(p)=mp_vacuous; else p=q; - do { - r=value(q); mp_type(q)=t; - switch (t) { - case mp_boolean_type: value(q)=v; break; - case mp_string_type: value(q)=v; add_str_ref(v); break; - case mp_pen_type: value(q)=copy_pen(v); break; - case mp_path_type: value(q)=mp_copy_path(mp, v); break; - case mp_picture_type: value(q)=v; add_edge_ref(v); break; - } /* there ain't no more cases */ - q=r; - } while (q!=p); -} - -@ If two members of rings are equated, and if they have the same type, -the |ring_merge| procedure is called on to make them equivalent. - -@c -static void mp_ring_merge (MP mp,pointer p, pointer q) { - pointer r; /* traverses one list */ - r=value(p); - while ( r!=p ) { - if ( r==q ) { - @<Exclaim about a redundant equation@>; - return; - }; - r=value(r); - } - r=value(p); value(p)=value(q); value(q)=r; -} - -@ @<Exclaim about a redundant equation@>= -{ - print_err("Redundant equation"); -@.Redundant equation@> - help2("I already knew that this equation was true.", - "But perhaps no harm has been done; let's continue."); - mp_put_get_error(mp); -} - -@* \[26] Introduction to the syntactic routines. -Let's pause a moment now and try to look at the Big Picture. -The \MP\ program consists of three main parts: syntactic routines, -semantic routines, and output routines. The chief purpose of the -syntactic routines is to deliver the user's input to the semantic routines, -while parsing expressions and locating operators and operands. The -semantic routines act as an interpreter responding to these operators, -which may be regarded as commands. And the output routines are -periodically called on to produce compact font descriptions that can be -used for typesetting or for making interim proof drawings. We have -discussed the basic data structures and many of the details of semantic -operations, so we are good and ready to plunge into the part of \MP\ that -actually controls the activities. - -Our current goal is to come to grips with the |get_next| procedure, -which is the keystone of \MP's input mechanism. Each call of |get_next| -sets the value of three variables |cur_cmd|, |cur_mod|, and |cur_sym|, -representing the next input token. -$$\vbox{\halign{#\hfil\cr - \hbox{|cur_cmd| denotes a command code from the long list of codes - given earlier;}\cr - \hbox{|cur_mod| denotes a modifier of the command code;}\cr - \hbox{|cur_sym| is the hash address of the symbolic token that was - just scanned,}\cr - \hbox{\qquad or zero in the case of a numeric or string - or capsule token.}\cr}}$$ -Underlying this external behavior of |get_next| is all the machinery -necessary to convert from character files to tokens. At a given time we -may be only partially finished with the reading of several files (for -which \&{input} was specified), and partially finished with the expansion -of some user-defined macros and/or some macro parameters, and partially -finished reading some text that the user has inserted online, -and so on. When reading a character file, the characters must be -converted to tokens; comments and blank spaces must -be removed, numeric and string tokens must be evaluated. - -To handle these situations, which might all be present simultaneously, -\MP\ uses various stacks that hold information about the incomplete -activities, and there is a finite state control for each level of the -input mechanism. These stacks record the current state of an implicitly -recursive process, but the |get_next| procedure is not recursive. - -@<Glob...@>= -integer cur_cmd; /* current command set by |get_next| */ -integer cur_mod; /* operand of current command */ -halfword cur_sym; /* hash address of current symbol */ - -@ The |print_cmd_mod| routine prints a symbolic interpretation of a -command code and its modifier. -It consists of a rather tedious sequence of print -commands, and most of it is essentially an inverse to the |primitive| -routine that enters a \MP\ primitive into |hash| and |eqtb|. Therefore almost -all of this procedure appears elsewhere in the program, together with the -corresponding |primitive| calls. - -@<Declarations@>= -static void mp_print_cmd_mod (MP mp,integer c, integer m) ; - -@ @c -void mp_print_cmd_mod (MP mp,integer c, integer m) { - switch (c) { - @<Cases of |print_cmd_mod| for symbolic printing of primitives@> - default: mp_print(mp, "[unknown command code!]"); break; - } -} - -@ Here is a procedure that displays a given command in braces, in the -user's transcript file. - -@d show_cur_cmd_mod mp_show_cmd_mod(mp, mp->cur_cmd,mp->cur_mod) - -@c -static void mp_show_cmd_mod (MP mp,integer c, integer m) { - mp_begin_diagnostic(mp); mp_print_nl(mp, "{"); - mp_print_cmd_mod(mp, c,m); mp_print_char(mp, xord('}')); - mp_end_diagnostic(mp, false); -} - -@* \[27] Input stacks and states. -The state of \MP's input mechanism appears in the input stack, whose -entries are records with five fields, called |index|, |start|, |loc|, -|limit|, and |name|. The top element of this stack is maintained in a -global variable for which no subscripting needs to be done; the other -elements of the stack appear in an array. Hence the stack is declared thus: - -@<Types...@>= -typedef struct { - quarterword index_field; - halfword start_field, loc_field, limit_field, name_field; -} in_state_record; - -@ @<Glob...@>= -in_state_record *input_stack; -integer input_ptr; /* first unused location of |input_stack| */ -integer max_in_stack; /* largest value of |input_ptr| when pushing */ -in_state_record cur_input; /* the ``top'' input state */ -int stack_size; /* maximum number of simultaneous input sources */ - -@ @<Allocate or initialize ...@>= -mp->stack_size = 300; -mp->input_stack = xmalloc((mp->stack_size+1),sizeof(in_state_record)); - -@ @<Dealloc variables@>= -xfree(mp->input_stack); - -@ We've already defined the special variable |loc==cur_input.loc_field| -in our discussion of basic input-output routines. The other components of -|cur_input| are defined in the same way: - -@d iindex mp->cur_input.index_field /* reference for buffer information */ -@d start mp->cur_input.start_field /* starting position in |buffer| */ -@d limit mp->cur_input.limit_field /* end of current line in |buffer| */ -@d name mp->cur_input.name_field /* name of the current file */ - -@ Let's look more closely now at the five control variables -(|index|,~|start|,~|loc|,~|limit|,~|name|), -assuming that \MP\ is reading a line of characters that have been input -from some file or from the user's terminal. There is an array called -|buffer| that acts as a stack of all lines of characters that are -currently being read from files, including all lines on subsidiary -levels of the input stack that are not yet completed. \MP\ will return to -the other lines when it is finished with the present input file. - -(Incidentally, on a machine with byte-oriented addressing, it would be -appropriate to combine |buffer| with the |str_pool| array, -letting the buffer entries grow downward from the top of the string pool -and checking that these two tables don't bump into each other.) - -The line we are currently working on begins in position |start| of the -buffer; the next character we are about to read is |buffer[loc]|; and -|limit| is the location of the last character present. We always have -|loc<=limit|. For convenience, |buffer[limit]| has been set to |"%"|, so -that the end of a line is easily sensed. - -The |name| variable is a string number that designates the name of -the current file, if we are reading an ordinary text file. Special codes -|is_term..max_spec_src| indicate other sources of input text. - -@d is_term 0 /* |name| value when reading from the terminal for normal input */ -@d is_read 1 /* |name| value when executing a \&{readstring} or \&{readfrom} */ -@d is_scantok 2 /* |name| value when reading text generated by \&{scantokens} */ -@d max_spec_src is_scantok - -@ Additional information about the current line is available via the -|index| variable, which counts how many lines of characters are present -in the buffer below the current level. We have |index=0| when reading -from the terminal and prompting the user for each line; then if the user types, -e.g., `\.{input figs}', we will have |index=1| while reading -the file \.{figs.mp}. However, it does not follow that |index| is the -same as the input stack pointer, since many of the levels on the input -stack may come from token lists and some |index| values may correspond -to \.{MPX} files that are not currently on the stack. - -The global variable |in_open| is equal to the highest |index| value counting -\.{MPX} files but excluding token-list input levels. Thus, the number of -partially read lines in the buffer is |in_open+1| and we have |in_open>=index| -when we are not reading a token list. - -If we are not currently reading from the terminal, -we are reading from the file variable |input_file[index]|. We use -the notation |terminal_input| as a convenient abbreviation for |name=is_term|, -and |cur_file| as an abbreviation for |input_file[index]|. - -When \MP\ is not reading from the terminal, the global variable |line| contains -the line number in the current file, for use in error messages. More precisely, -|line| is a macro for |line_stack[index]| and the |line_stack| array gives -the line number for each file in the |input_file| array. - -When an \.{MPX} file is opened the file name is stored in the |mpx_name| -array so that the name doesn't get lost when the file is temporarily removed -from the input stack. -Thus when |input_file[k]| is an \.{MPX} file, its name is |mpx_name[k]| -and it contains translated \TeX\ pictures for |input_file[k-1]|. -Since this is not an \.{MPX} file, we have -$$ \hbox{|mpx_name[k-1]<=absent|}. $$ -This |name| field is set to |finished| when |input_file[k]| is completely -read. - -If more information about the input state is needed, it can be -included in small arrays like those shown here. For example, -the current page or segment number in the input file might be put -into a variable |page|, that is really a macro for the current entry -in `\ignorespaces|page_stack:array[0..max_in_open] of integer|\unskip' -by analogy with |line_stack|. -@^system dependencies@> - -@d terminal_input (name==is_term) /* are we reading from the terminal? */ -@d cur_file mp->input_file[iindex] /* the current |void *| variable */ -@d line mp->line_stack[iindex] /* current line number in the current source file */ -@d in_name mp->iname_stack[iindex] /* a string used to construct \.{MPX} file names */ -@d in_area mp->iarea_stack[iindex] /* another string for naming \.{MPX} files */ -@d absent 1 /* |name_field| value for unused |mpx_in_stack| entries */ -@d mpx_reading (mp->mpx_name[iindex]>absent) - /* when reading a file, is it an \.{MPX} file? */ -@d mpx_finished 0 - /* |name_field| value when the corresponding \.{MPX} file is finished */ - -@<Glob...@>= -integer in_open; /* the number of lines in the buffer, less one */ -unsigned int open_parens; /* the number of open text files */ -void * *input_file ; -integer *line_stack ; /* the line number for each file */ -char * *iname_stack; /* used for naming \.{MPX} files */ -char * *iarea_stack; /* used for naming \.{MPX} files */ -halfword*mpx_name ; - -@ @<Allocate or ...@>= -mp->input_file = xmalloc((mp->max_in_open+1),sizeof(void *)); -mp->line_stack = xmalloc((mp->max_in_open+1),sizeof(integer)); -mp->iname_stack = xmalloc((mp->max_in_open+1),sizeof(char *)); -mp->iarea_stack = xmalloc((mp->max_in_open+1),sizeof(char *)); -mp->mpx_name = xmalloc((mp->max_in_open+1),sizeof(halfword)); -{ - int k; - for (k=0;k<=mp->max_in_open;k++) { - mp->iname_stack[k] =NULL; - mp->iarea_stack[k] =NULL; - } -} - -@ @<Dealloc variables@>= -{ - int l; - for (l=0;l<=mp->max_in_open;l++) { - xfree(mp->iname_stack[l]); - xfree(mp->iarea_stack[l]); - } -} -xfree(mp->input_file); -xfree(mp->line_stack); -xfree(mp->iname_stack); -xfree(mp->iarea_stack); -xfree(mp->mpx_name); - - -@ However, all this discussion about input state really applies only to the -case that we are inputting from a file. There is another important case, -namely when we are currently getting input from a token list. In this case -|iindex>max_in_open|, and the conventions about the other state variables -are different: - -\yskip\hang|loc| is a pointer to the current node in the token list, i.e., -the node that will be read next. If |loc=null|, the token list has been -fully read. - -\yskip\hang|start| points to the first node of the token list; this node -may or may not contain a reference count, depending on the type of token -list involved. - -\yskip\hang|token_type|, which takes the place of |iindex| in the -discussion above, is a code number that explains what kind of token list -is being scanned. - -\yskip\hang|name| points to the |eqtb| address of the control sequence -being expanded, if the current token list is a macro not defined by -\&{vardef}. Macros defined by \&{vardef} have |name=null|; their name -can be deduced by looking at their first two parameters. - -\yskip\hang|param_start|, which takes the place of |limit|, tells where -the parameters of the current macro or loop text begin in the |param_stack|. - -\yskip\noindent The |token_type| can take several values, depending on -where the current token list came from: - -\yskip -\indent|forever_text|, if the token list being scanned is the body of -a \&{forever} loop; - -\indent|loop_text|, if the token list being scanned is the body of -a \&{for} or \&{forsuffixes} loop; - -\indent|parameter|, if a \&{text} or \&{suffix} parameter is being scanned; - -\indent|backed_up|, if the token list being scanned has been inserted as -`to be read again'. - -\indent|inserted|, if the token list being scanned has been inserted as -part of error recovery; - -\indent|macro|, if the expansion of a user-defined symbolic token is being -scanned. - -\yskip\noindent -The token list begins with a reference count if and only if |token_type= -macro|. -@^reference counts@> - -@d token_type iindex /* type of current token list */ -@d token_state (iindex>(int)mp->max_in_open) /* are we scanning a token list? */ -@d file_state (iindex<=(int)mp->max_in_open) /* are we scanning a file line? */ -@d param_start limit /* base of macro parameters in |param_stack| */ -@d forever_text (mp->max_in_open+1) /* |token_type| code for loop texts */ -@d loop_text (mp->max_in_open+2) /* |token_type| code for loop texts */ -@d parameter (mp->max_in_open+3) /* |token_type| code for parameter texts */ -@d backed_up (mp->max_in_open+4) /* |token_type| code for texts to be reread */ -@d inserted (mp->max_in_open+5) /* |token_type| code for inserted texts */ -@d macro (mp->max_in_open+6) /* |token_type| code for macro replacement texts */ - -@ The |param_stack| is an auxiliary array used to hold pointers to the token -lists for parameters at the current level and subsidiary levels of input. -This stack grows at a different rate from the others. - -@<Glob...@>= -pointer *param_stack; /* token list pointers for parameters */ -integer param_ptr; /* first unused entry in |param_stack| */ -integer max_param_stack; /* largest value of |param_ptr| */ - -@ @<Allocate or initialize ...@>= -mp->param_stack = xmalloc((mp->param_size+1),sizeof(pointer)); - -@ @<Dealloc variables@>= -xfree(mp->param_stack); - -@ Notice that the |line| isn't valid when |token_state| is true because it -depends on |iindex|. If we really need to know the line number for the -topmost file in the iindex stack we use the following function. If a page -number or other information is needed, this routine should be modified to -compute it as well. -@^system dependencies@> - -@<Declarations@>= -static integer mp_true_line (MP mp) ; - -@ @c -integer mp_true_line (MP mp) { - int k; /* an index into the input stack */ - if ( file_state && (name>max_spec_src) ) { - return line; - } else { - k=mp->input_ptr; - while ((k>0) && - ((mp->input_stack[(k-1)].index_field>mp->max_in_open)|| - (mp->input_stack[(k-1)].name_field<=max_spec_src))) { - decr(k); - } - return (k>0 ? mp->line_stack[(k-1)] : 0 ); - } -} - -@ Thus, the ``current input state'' can be very complicated indeed; there -can be many levels and each level can arise in a variety of ways. The -|show_context| procedure, which is used by \MP's error-reporting routine to -print out the current input state on all levels down to the most recent -line of characters from an input file, illustrates most of these conventions. -The global variable |file_ptr| contains the lowest level that was -displayed by this procedure. - -@<Glob...@>= -integer file_ptr; /* shallowest level shown by |show_context| */ - -@ The status at each level is indicated by printing two lines, where the first -line indicates what was read so far and the second line shows what remains -to be read. The context is cropped, if necessary, so that the first line -contains at most |half_error_line| characters, and the second contains -at most |error_line|. Non-current input levels whose |token_type| is -`|backed_up|' are shown only if they have not been fully read. - -@c void mp_show_context (MP mp) { /* prints where the scanner is */ - unsigned old_setting; /* saved |selector| setting */ - @<Local variables for formatting calculations@> - mp->file_ptr=mp->input_ptr; mp->input_stack[mp->file_ptr]=mp->cur_input; - /* store current state */ - while (1) { - mp->cur_input=mp->input_stack[mp->file_ptr]; /* enter into the context */ - @<Display the current context@>; - if ( file_state ) - if ( (name>max_spec_src) || (mp->file_ptr==0) ) break; - decr(mp->file_ptr); - } - mp->cur_input=mp->input_stack[mp->input_ptr]; /* restore original state */ -} - -@ @<Display the current context@>= -if ( (mp->file_ptr==mp->input_ptr) || file_state || - (token_type!=backed_up) || (loc!=null) ) { - /* we omit backed-up token lists that have already been read */ - mp->tally=0; /* get ready to count characters */ - old_setting=mp->selector; - if ( file_state ) { - @<Print location of current line@>; - @<Pseudoprint the line@>; - } else { - @<Print type of token list@>; - @<Pseudoprint the token list@>; - } - mp->selector=old_setting; /* stop pseudoprinting */ - @<Print two lines using the tricky pseudoprinted information@>; -} - -@ This routine should be changed, if necessary, to give the best possible -indication of where the current line resides in the input file. -For example, on some systems it is best to print both a page and line number. -@^system dependencies@> - -@<Print location of current line@>= -if ( name>max_spec_src ) { - mp_print_nl(mp, "l."); mp_print_int(mp, mp_true_line(mp)); -} else if ( terminal_input ) { - if ( mp->file_ptr==0 ) mp_print_nl(mp, "<*>"); - else mp_print_nl(mp, "<insert>"); -} else if ( name==is_scantok ) { - mp_print_nl(mp, "<scantokens>"); -} else { - mp_print_nl(mp, "<read>"); -} -mp_print_char(mp, xord(' ')) - -@ Can't use case statement here because the |token_type| is not -a constant expression. - -@<Print type of token list@>= -{ - if(token_type==forever_text) { - mp_print_nl(mp, "<forever> "); - } else if (token_type==loop_text) { - @<Print the current loop value@>; - } else if (token_type==parameter) { - mp_print_nl(mp, "<argument> "); - } else if (token_type==backed_up) { - if ( loc==null ) mp_print_nl(mp, "<recently read> "); - else mp_print_nl(mp, "<to be read again> "); - } else if (token_type==inserted) { - mp_print_nl(mp, "<inserted text> "); - } else if (token_type==macro) { - mp_print_ln(mp); - if ( name!=null ) mp_print_text(name); - else @<Print the name of a \&{vardef}'d macro@>; - mp_print(mp, "->"); - } else { - mp_print_nl(mp, "?");/* this should never happen */ -@.?\relax@> - } -} - -@ The parameter that corresponds to a loop text is either a token list -(in the case of \&{forsuffixes}) or a ``capsule'' (in the case of \&{for}). -We'll discuss capsules later; for now, all we need to know is that -the |link| field in a capsule parameter is |void| and that -|print_exp(p,0)| displays the value of capsule~|p| in abbreviated form. - -@<Print the current loop value@>= -{ mp_print_nl(mp, "<for("); p=mp->param_stack[param_start]; - if ( p!=null ) { - if ( mp_link(p)==mp_void ) mp_print_exp(mp, p,0); /* we're in a \&{for} loop */ - else mp_show_token_list(mp, p,null,20,mp->tally); - } - mp_print(mp, ")> "); -} - -@ The first two parameters of a macro defined by \&{vardef} will be token -lists representing the macro's prefix and ``at point.'' By putting these -together, we get the macro's full name. - -@<Print the name of a \&{vardef}'d macro@>= -{ p=mp->param_stack[param_start]; - if ( p==null ) { - mp_show_token_list(mp, mp->param_stack[param_start+1],null,20,mp->tally); - } else { - q=p; - while ( mp_link(q)!=null ) q=mp_link(q); - mp_link(q)=mp->param_stack[param_start+1]; - mp_show_token_list(mp, p,null,20,mp->tally); - mp_link(q)=null; - } -} - -@ Now it is necessary to explain a little trick. We don't want to store a long -string that corresponds to a token list, because that string might take up -lots of memory; and we are printing during a time when an error message is -being given, so we dare not do anything that might overflow one of \MP's -tables. So `pseudoprinting' is the answer: We enter a mode of printing -that stores characters into a buffer of length |error_line|, where character -$k+1$ is placed into \hbox{|trick_buf[k mod error_line]|} if -|k<trick_count|, otherwise character |k| is dropped. Initially we set -|tally:=0| and |trick_count:=1000000|; then when we reach the -point where transition from line 1 to line 2 should occur, we -set |first_count:=tally| and |trick_count:=@tmax@>(error_line, -tally+1+error_line-half_error_line)|. At the end of the -pseudoprinting, the values of |first_count|, |tally|, and -|trick_count| give us all the information we need to print the two lines, -and all of the necessary text is in |trick_buf|. - -Namely, let |l| be the length of the descriptive information that appears -on the first line. The length of the context information gathered for that -line is |k=first_count|, and the length of the context information -gathered for line~2 is $m=\min(|tally|, |trick_count|)-k$. If |l+k<=h|, -where |h=half_error_line|, we print |trick_buf[0..k-1]| after the -descriptive information on line~1, and set |n:=l+k|; here |n| is the -length of line~1. If $l+k>h$, some cropping is necessary, so we set |n:=h| -and print `\.{...}' followed by -$$\hbox{|trick_buf[(l+k-h+3)..k-1]|,}$$ -where subscripts of |trick_buf| are circular modulo |error_line|. The -second line consists of |n|~spaces followed by |trick_buf[k..(k+m-1)]|, -unless |n+m>error_line|; in the latter case, further cropping is done. -This is easier to program than to explain. - -@<Local variables for formatting...@>= -int i; /* index into |buffer| */ -integer l; /* length of descriptive information on line 1 */ -integer m; /* context information gathered for line 2 */ -int n; /* length of line 1 */ -integer p; /* starting or ending place in |trick_buf| */ -integer q; /* temporary index */ - -@ The following code tells the print routines to gather -the desired information. - -@d begin_pseudoprint { - l=mp->tally; mp->tally=0; mp->selector=pseudo; - mp->trick_count=1000000; -} -@d set_trick_count { - mp->first_count=mp->tally; - mp->trick_count=mp->tally+1+mp->error_line-mp->half_error_line; - if ( mp->trick_count<mp->error_line ) mp->trick_count=mp->error_line; -} - -@ And the following code uses the information after it has been gathered. - -@<Print two lines using the tricky pseudoprinted information@>= -if ( mp->trick_count==1000000 ) set_trick_count; - /* |set_trick_count| must be performed */ -if ( mp->tally<mp->trick_count ) m=mp->tally-mp->first_count; -else m=mp->trick_count-mp->first_count; /* context on line 2 */ -if ( l+mp->first_count<=mp->half_error_line ) { - p=0; n=l+mp->first_count; -} else { - mp_print(mp, "..."); p=l+mp->first_count-mp->half_error_line+3; - n=mp->half_error_line; -} -for (q=p;q<=mp->first_count-1;q++) { - mp_print_char(mp, mp->trick_buf[q % mp->error_line]); -} -mp_print_ln(mp); -for (q=1;q<=n;q++) { - mp_print_char(mp, xord(' ')); /* print |n| spaces to begin line~2 */ -} -if ( m+n<=mp->error_line ) p=mp->first_count+m; -else p=mp->first_count+(mp->error_line-n-3); -for (q=mp->first_count;q<=p-1;q++) { - mp_print_char(mp, mp->trick_buf[q % mp->error_line]); -} -if ( m+n>mp->error_line ) mp_print(mp, "...") - -@ But the trick is distracting us from our current goal, which is to -understand the input state. So let's concentrate on the data structures that -are being pseudoprinted as we finish up the |show_context| procedure. - -@<Pseudoprint the line@>= -begin_pseudoprint; -if ( limit>0 ) { - for (i=start;i<=limit-1;i++) { - if ( i==loc ) set_trick_count; - mp_print_str(mp, mp->buffer[i]); - } -} - -@ @<Pseudoprint the token list@>= -begin_pseudoprint; -if ( token_type!=macro ) mp_show_token_list(mp, start,loc,100000,0); -else mp_show_macro(mp, start,loc,100000) - -@ Here is the missing piece of |show_token_list| that is activated when the -token beginning line~2 is about to be shown: - -@<Do magic computation@>=set_trick_count - -@* \[28] Maintaining the input stacks. -The following subroutines change the input status in commonly needed ways. - -First comes |push_input|, which stores the current state and creates a -new level (having, initially, the same properties as the old). - -@d push_input { /* enter a new input level, save the old */ - if ( mp->input_ptr>mp->max_in_stack ) { - mp->max_in_stack=mp->input_ptr; - if ( mp->input_ptr==mp->stack_size ) { - int l = (mp->stack_size+(mp->stack_size/4)); - XREALLOC(mp->input_stack, l, in_state_record); - mp->stack_size = l; - } - } - mp->input_stack[mp->input_ptr]=mp->cur_input; /* stack the record */ - incr(mp->input_ptr); -} - -@ And of course what goes up must come down. - -@d pop_input { /* leave an input level, re-enter the old */ - decr(mp->input_ptr); mp->cur_input=mp->input_stack[mp->input_ptr]; - } - -@ Here is a procedure that starts a new level of token-list input, given -a token list |p| and its type |t|. If |t=macro|, the calling routine should -set |name|, reset~|loc|, and increase the macro's reference count. - -@d back_list(A) mp_begin_token_list(mp, (A),backed_up) /* backs up a simple token list */ - -@c -static void mp_begin_token_list (MP mp,pointer p, quarterword t) { - push_input; start=p; token_type=t; - param_start=mp->param_ptr; loc=p; -} - -@ When a token list has been fully scanned, the following computations -should be done as we leave that level of input. -@^inner loop@> - -@c -static void mp_end_token_list (MP mp) { /* leave a token-list input level */ - pointer p; /* temporary register */ - if ( token_type>=backed_up ) { /* token list to be deleted */ - if ( token_type<=inserted ) { - mp_flush_token_list(mp, start); goto DONE; - } else { - mp_delete_mac_ref(mp, start); /* update reference count */ - } - } - while ( mp->param_ptr>param_start ) { /* parameters must be flushed */ - decr(mp->param_ptr); - p=mp->param_stack[mp->param_ptr]; - if ( p!=null ) { - if ( mp_link(p)==mp_void ) { /* it's an \&{expr} parameter */ - mp_recycle_value(mp, p); mp_free_node(mp, p,value_node_size); - } else { - mp_flush_token_list(mp, p); /* it's a \&{suffix} or \&{text} parameter */ - } - } - } -DONE: - pop_input; check_interrupt; -} - -@ The contents of |cur_cmd,cur_mod,cur_sym| are placed into an equivalent -token by the |cur_tok| routine. -@^inner loop@> - -@c @<Declare the procedure called |make_exp_copy|@> -static pointer mp_cur_tok (MP mp) { - pointer p; /* a new token node */ - quarterword save_type; /* |cur_type| to be restored */ - integer save_exp; /* |cur_exp| to be restored */ - if ( mp->cur_sym==0 ) { - if ( mp->cur_cmd==capsule_token ) { - save_type=mp->cur_type; save_exp=mp->cur_exp; - mp_make_exp_copy(mp, mp->cur_mod); p=mp_stash_cur_exp(mp); mp_link(p)=null; - mp->cur_type=save_type; mp->cur_exp=save_exp; - } else { - p=mp_get_node(mp, token_node_size); - value(p)=mp->cur_mod; mp_name_type(p)=mp_token; - if ( mp->cur_cmd==numeric_token ) mp_type(p)=mp_known; - else mp_type(p)=mp_string_type; - } - } else { - fast_get_avail(p); mp_info(p)=mp->cur_sym; - } - return p; -} - -@ Sometimes \MP\ has read too far and wants to ``unscan'' what it has -seen. The |back_input| procedure takes care of this by putting the token -just scanned back into the input stream, ready to be read again. -If |cur_sym<>0|, the values of |cur_cmd| and |cur_mod| are irrelevant. - -@<Declarations@>= -static void mp_back_input (MP mp); - -@ @c void mp_back_input (MP mp) {/* undoes one token of input */ - pointer p; /* a token list of length one */ - p=mp_cur_tok(mp); - while ( token_state &&(loc==null) ) - mp_end_token_list(mp); /* conserve stack space */ - back_list(p); -} - -@ The |back_error| routine is used when we want to restore or replace an -offending token just before issuing an error message. We disable interrupts -during the call of |back_input| so that the help message won't be lost. - -@ @c static void mp_back_error (MP mp) { /* back up one token and call |error| */ - mp->OK_to_interrupt=false; - mp_back_input(mp); - mp->OK_to_interrupt=true; mp_error(mp); -} -static void mp_ins_error (MP mp) { /* back up one inserted token and call |error| */ - mp->OK_to_interrupt=false; - mp_back_input(mp); token_type=inserted; - mp->OK_to_interrupt=true; mp_error(mp); -} - -@ The |begin_file_reading| procedure starts a new level of input for lines -of characters to be read from a file, or as an insertion from the -terminal. It does not take care of opening the file, nor does it set |loc| -or |limit| or |line|. -@^system dependencies@> - -@c void mp_begin_file_reading (MP mp) { - if ( mp->in_open==mp->max_in_open ) - mp_overflow(mp, "text input levels",mp->max_in_open); -@:MetaPost capacity exceeded text input levels}{\quad text input levels@> - if ( mp->first==mp->buf_size ) - mp_reallocate_buffer(mp,(mp->buf_size+(mp->buf_size/4))); - incr(mp->in_open); push_input; iindex=mp->in_open; - mp->mpx_name[iindex]=absent; - start=(halfword)mp->first; - name=is_term; /* |terminal_input| is now |true| */ -} - -@ Conversely, the variables must be downdated when such a level of input -is finished. Any associated \.{MPX} file must also be closed and popped -off the file stack. - -@c static void mp_end_file_reading (MP mp) { - if ( mp->in_open>iindex ) { - if ( (mp->mpx_name[mp->in_open]==absent)||(name<=max_spec_src) ) { - mp_confusion(mp, "endinput"); -@:this can't happen endinput}{\quad endinput@> - } else { - (mp->close_file)(mp,mp->input_file[mp->in_open]); /* close an \.{MPX} file */ - delete_str_ref(mp->mpx_name[mp->in_open]); - decr(mp->in_open); - } - } - mp->first=(size_t)start; - if ( iindex!=mp->in_open ) mp_confusion(mp, "endinput"); - if ( name>max_spec_src ) { - (mp->close_file)(mp,cur_file); - delete_str_ref(name); - xfree(in_name); - xfree(in_area); - } - pop_input; decr(mp->in_open); -} - -@ Here is a function that tries to resume input from an \.{MPX} file already -associated with the current input file. It returns |false| if this doesn't -work. - -@c static boolean mp_begin_mpx_reading (MP mp) { - if ( mp->in_open!=iindex+1 ) { - return false; - } else { - if ( mp->mpx_name[mp->in_open]<=absent ) mp_confusion(mp, "mpx"); -@:this can't happen mpx}{\quad mpx@> - if ( mp->first==mp->buf_size ) - mp_reallocate_buffer(mp,(mp->buf_size+(mp->buf_size/4))); - push_input; iindex=mp->in_open; - start=(halfword)mp->first; - name=mp->mpx_name[mp->in_open]; add_str_ref(name); - @<Put an empty line in the input buffer@>; - return true; - } -} - -@ This procedure temporarily stops reading an \.{MPX} file. - -@c static void mp_end_mpx_reading (MP mp) { - if ( mp->in_open!=iindex ) mp_confusion(mp, "mpx"); -@:this can't happen mpx}{\quad mpx@> - if ( loc<limit ) { - @<Complain that we are not at the end of a line in the \.{MPX} file@>; - } - mp->first=(size_t)start; - pop_input; -} - -@ Here we enforce a restriction that simplifies the input stacks considerably. -This should not inconvenience the user because \.{MPX} files are generated -by an auxiliary program called \.{DVItoMP}. - -@ @<Complain that we are not at the end of a line in the \.{MPX} file@>= -{ -print_err("`mpxbreak' must be at the end of a line"); -help4("This file contains picture expressions for btex...etex", - "blocks. Such files are normally generated automatically", - "but this one seems to be messed up. I'm going to ignore", - "the rest of this line."); -mp_error(mp); -} - -@ In order to keep the stack from overflowing during a long sequence of -inserted `\.{show}' commands, the following routine removes completed -error-inserted lines from memory. - -@c void mp_clear_for_error_prompt (MP mp) { - while ( file_state && terminal_input && - (mp->input_ptr>0)&&(loc==limit) ) mp_end_file_reading(mp); - mp_print_ln(mp); clear_terminal; -} - -@ To get \MP's whole input mechanism going, we perform the following -actions. - -@<Initialize the input routines@>= -{ mp->input_ptr=0; mp->max_in_stack=0; - mp->in_open=0; mp->open_parens=0; mp->max_buf_stack=0; - mp->param_ptr=0; mp->max_param_stack=0; - mp->first=1; - start=1; iindex=0; line=0; name=is_term; - mp->mpx_name[0]=absent; - mp->force_eof=false; - if ( ! mp_init_terminal(mp) ) mp_jump_out(mp); - limit=(halfword)mp->last; mp->first=mp->last+1; - /* |init_terminal| has set |loc| and |last| */ -} - -@* \[29] Getting the next token. -The heart of \MP's input mechanism is the |get_next| procedure, which -we shall develop in the next few sections of the program. Perhaps we -shouldn't actually call it the ``heart,'' however; it really acts as \MP's -eyes and mouth, reading the source files and gobbling them up. And it also -helps \MP\ to regurgitate stored token lists that are to be processed again. - -The main duty of |get_next| is to input one token and to set |cur_cmd| -and |cur_mod| to that token's command code and modifier. Furthermore, if -the input token is a symbolic token, that token's |hash| address -is stored in |cur_sym|; otherwise |cur_sym| is set to zero. - -Underlying this simple description is a certain amount of complexity -because of all the cases that need to be handled. -However, the inner loop of |get_next| is reasonably short and fast. - -@ Before getting into |get_next|, we need to consider a mechanism by which -\MP\ helps keep errors from propagating too far. Whenever the program goes -into a mode where it keeps calling |get_next| repeatedly until a certain -condition is met, it sets |scanner_status| to some value other than |normal|. -Then if an input file ends, or if an `\&{outer}' symbol appears, -an appropriate error recovery will be possible. - -The global variable |warning_info| helps in this error recovery by providing -additional information. For example, |warning_info| might indicate the -name of a macro whose replacement text is being scanned. - -@d normal 0 /* |scanner_status| at ``quiet times'' */ -@d skipping 1 /* |scanner_status| when false conditional text is being skipped */ -@d flushing 2 /* |scanner_status| when junk after a statement is being ignored */ -@d absorbing 3 /* |scanner_status| when a \&{text} parameter is being scanned */ -@d var_defining 4 /* |scanner_status| when a \&{vardef} is being scanned */ -@d op_defining 5 /* |scanner_status| when a macro \&{def} is being scanned */ -@d loop_defining 6 /* |scanner_status| when a \&{for} loop is being scanned */ -@d tex_flushing 7 /* |scanner_status| when skipping \TeX\ material */ - -@<Glob...@>= -integer scanner_status; /* are we scanning at high speed? */ -integer warning_info; /* if so, what else do we need to know, - in case an error occurs? */ - -@ @<Initialize the input routines@>= -mp->scanner_status=normal; - -@ The following subroutine -is called when an `\&{outer}' symbolic token has been scanned or -when the end of a file has been reached. These two cases are distinguished -by |cur_sym|, which is zero at the end of a file. - -@c -static boolean mp_check_outer_validity (MP mp) { - pointer p; /* points to inserted token list */ - if ( mp->scanner_status==normal ) { - return true; - } else if ( mp->scanner_status==tex_flushing ) { - @<Check if the file has ended while flushing \TeX\ material and set the - result value for |check_outer_validity|@>; - } else { - mp->deletions_allowed=false; - @<Back up an outer symbolic token so that it can be reread@>; - if ( mp->scanner_status>skipping ) { - @<Tell the user what has run away and try to recover@>; - } else { - print_err("Incomplete if; all text was ignored after line "); -@.Incomplete if...@> - mp_print_int(mp, mp->warning_info); - help3("A forbidden `outer' token occurred in skipped text.", - "This kind of error happens when you say `if...' and forget", - "the matching `fi'. I've inserted a `fi'; this might work."); - if ( mp->cur_sym==0 ) - mp->help_line[2]="The file ended while I was skipping conditional text."; - mp->cur_sym=frozen_fi; mp_ins_error(mp); - } - mp->deletions_allowed=true; - return false; - } -} - -@ @<Check if the file has ended while flushing \TeX\ material and set...@>= -if ( mp->cur_sym!=0 ) { - return true; -} else { - mp->deletions_allowed=false; - print_err("TeX mode didn't end; all text was ignored after line "); - mp_print_int(mp, mp->warning_info); - help2("The file ended while I was looking for the `etex' to", - "finish this TeX material. I've inserted `etex' now."); - mp->cur_sym = frozen_etex; - mp_ins_error(mp); - mp->deletions_allowed=true; - return false; -} - -@ @<Back up an outer symbolic token so that it can be reread@>= -if ( mp->cur_sym!=0 ) { - p=mp_get_avail(mp); mp_info(p)=mp->cur_sym; - back_list(p); /* prepare to read the symbolic token again */ -} - -@ @<Tell the user what has run away...@>= -{ - mp_runaway(mp); /* print the definition-so-far */ - if ( mp->cur_sym==0 ) { - print_err("File ended"); -@.File ended while scanning...@> - } else { - print_err("Forbidden token found"); -@.Forbidden token found...@> - } - mp_print(mp, " while scanning "); - help4("I suspect you have forgotten an `enddef',", - "causing me to read past where you wanted me to stop.", - "I'll try to recover; but if the error is serious,", - "you'd better type `E' or `X' now and fix your file."); - switch (mp->scanner_status) { - @<Complete the error message, - and set |cur_sym| to a token that might help recover from the error@> - } /* there are no other cases */ - mp_ins_error(mp); -} - -@ As we consider various kinds of errors, it is also appropriate to -change the first line of the help message just given; |help_line[3]| -points to the string that might be changed. - -@<Complete the error message,...@>= -case flushing: - mp_print(mp, "to the end of the statement"); - mp->help_line[3]="A previous error seems to have propagated,"; - mp->cur_sym=frozen_semicolon; - break; -case absorbing: - mp_print(mp, "a text argument"); - mp->help_line[3]="It seems that a right delimiter was left out,"; - if ( mp->warning_info==0 ) { - mp->cur_sym=frozen_end_group; - } else { - mp->cur_sym=frozen_right_delimiter; - equiv(frozen_right_delimiter)=mp->warning_info; - } - break; -case var_defining: -case op_defining: - mp_print(mp, "the definition of "); - if ( mp->scanner_status==op_defining ) - mp_print_text(mp->warning_info); - else - mp_print_variable_name(mp, mp->warning_info); - mp->cur_sym=frozen_end_def; - break; -case loop_defining: - mp_print(mp, "the text of a "); - mp_print_text(mp->warning_info); - mp_print(mp, " loop"); - mp->help_line[3]="I suspect you have forgotten an `endfor',"; - mp->cur_sym=frozen_end_for; - break; - -@ The |runaway| procedure displays the first part of the text that occurred -when \MP\ began its special |scanner_status|, if that text has been saved. - -@<Declarations@>= -static void mp_runaway (MP mp) ; - -@ @c -void mp_runaway (MP mp) { - if ( mp->scanner_status>flushing ) { - mp_print_nl(mp, "Runaway "); - switch (mp->scanner_status) { - case absorbing: mp_print(mp, "text?"); break; - case var_defining: - case op_defining: mp_print(mp,"definition?"); break; - case loop_defining: mp_print(mp, "loop?"); break; - } /* there are no other cases */ - mp_print_ln(mp); - mp_show_token_list(mp, mp_link(hold_head),null,mp->error_line-10,0); - } -} - -@ We need to mention a procedure that may be called by |get_next|. - -@<Declarations@>= -static void mp_firm_up_the_line (MP mp); - -@ And now we're ready to take the plunge into |get_next| itself. -Note that the behavior depends on the |scanner_status| because percent signs -and double quotes need to be passed over when skipping TeX material. - -@c -void mp_get_next (MP mp) { - /* sets |cur_cmd|, |cur_mod|, |cur_sym| to next token */ -@^inner loop@> - /*restart*/ /* go here to get the next input token */ - /*exit*/ /* go here when the next input token has been got */ - /*|common_ending|*/ /* go here to finish getting a symbolic token */ - /*found*/ /* go here when the end of a symbolic token has been found */ - /*switch*/ /* go here to branch on the class of an input character */ - /*|start_numeric_token|,|start_decimal_token|,|fin_numeric_token|,|done|*/ - /* go here at crucial stages when scanning a number */ - int k; /* an index into |buffer| */ - ASCII_code c; /* the current character in the buffer */ - int class; /* its class number */ - integer n,f; /* registers for decimal-to-binary conversion */ -RESTART: - mp->cur_sym=0; - if ( file_state ) { - @<Input from external file; |goto restart| if no input found, - or |return| if a non-symbolic token is found@>; - } else { - @<Input from token list; |goto restart| if end of list or - if a parameter needs to be expanded, - or |return| if a non-symbolic token is found@>; - } -COMMON_ENDING: - @<Finish getting the symbolic token in |cur_sym|; - |goto restart| if it is illegal@>; -} - -@ When a symbolic token is declared to be `\&{outer}', its command code -is increased by |outer_tag|. -@^inner loop@> - -@<Finish getting the symbolic token in |cur_sym|...@>= -mp->cur_cmd=eq_type(mp->cur_sym); mp->cur_mod=equiv(mp->cur_sym); -if ( mp->cur_cmd>=outer_tag ) { - if ( mp_check_outer_validity(mp) ) - mp->cur_cmd=mp->cur_cmd-outer_tag; - else - goto RESTART; -} - -@ A percent sign appears in |buffer[limit]|; this makes it unnecessary -to have a special test for end-of-line. -@^inner loop@> - -@<Input from external file;...@>= -{ -SWITCH: - c=mp->buffer[loc]; incr(loc); class=mp->char_class[c]; - switch (class) { - case digit_class: goto START_NUMERIC_TOKEN; break; - case period_class: - class=mp->char_class[mp->buffer[loc]]; - if ( class>period_class ) { - goto SWITCH; - } else if ( class<period_class ) { /* |class=digit_class| */ - n=0; goto START_DECIMAL_TOKEN; - } -@:. }{\..\ token@> - break; - case space_class: goto SWITCH; break; - case percent_class: - if ( mp->scanner_status==tex_flushing ) { - if ( loc<limit ) goto SWITCH; - } - @<Move to next line of file, or |goto restart| if there is no next line@>; - check_interrupt; - goto SWITCH; - break; - case string_class: - if ( mp->scanner_status==tex_flushing ) goto SWITCH; - else @<Get a string token and |return|@>; - break; - case isolated_classes: - k=loc-1; goto FOUND; break; - case invalid_class: - if ( mp->scanner_status==tex_flushing ) goto SWITCH; - else @<Decry the invalid character and |goto restart|@>; - break; - default: break; /* letters, etc. */ - } - k=loc-1; - while ( mp->char_class[mp->buffer[loc]]==class ) incr(loc); - goto FOUND; -START_NUMERIC_TOKEN: - @<Get the integer part |n| of a numeric token; - set |f:=0| and |goto fin_numeric_token| if there is no decimal point@>; -START_DECIMAL_TOKEN: - @<Get the fraction part |f| of a numeric token@>; -FIN_NUMERIC_TOKEN: - @<Pack the numeric and fraction parts of a numeric token - and |return|@>; -FOUND: - mp->cur_sym=mp_id_lookup(mp, k,loc-k); -} - -@ We go to |restart| instead of to |SWITCH|, because we might enter -|token_state| after the error has been dealt with -(cf.\ |clear_for_error_prompt|). - -@<Decry the invalid...@>= -{ - print_err("Text line contains an invalid character"); -@.Text line contains...@> - help2("A funny symbol that I can\'t read has just been input.", - "Continue, and I'll forget that it ever happened."); - mp->deletions_allowed=false; mp_error(mp); mp->deletions_allowed=true; - goto RESTART; -} - -@ @<Get a string token and |return|@>= -{ - if ( mp->buffer[loc]=='"' ) { - mp->cur_mod=null_str; - } else { - k=loc; mp->buffer[limit+1]=xord('"'); - do { - incr(loc); - } while (mp->buffer[loc]!='"'); - if ( loc>limit ) { - @<Decry the missing string delimiter and |goto restart|@>; - } - if ( loc==k+1 ) { - mp->cur_mod=mp->buffer[k]; - } else { - str_room(loc-k); - do { - append_char(mp->buffer[k]); incr(k); - } while (k!=loc); - mp->cur_mod=mp_make_string(mp); - } - } - incr(loc); mp->cur_cmd=string_token; - return; -} - -@ We go to |restart| after this error message, not to |SWITCH|, -because the |clear_for_error_prompt| routine might have reinstated -|token_state| after |error| has finished. - -@<Decry the missing string delimiter and |goto restart|@>= -{ - loc=limit; /* the next character to be read on this line will be |"%"| */ - print_err("Incomplete string token has been flushed"); -@.Incomplete string token...@> - help3("Strings should finish on the same line as they began.", - "I've deleted the partial string; you might want to", - "insert another by typing, e.g., `I\"new string\"'."); - mp->deletions_allowed=false; mp_error(mp); - mp->deletions_allowed=true; - goto RESTART; -} - -@ @<Get the integer part |n| of a numeric token...@>= -n=c-'0'; -while ( mp->char_class[mp->buffer[loc]]==digit_class ) { - if ( n<32768 ) n=10*n+mp->buffer[loc]-'0'; - incr(loc); -} -if ( mp->buffer[loc]=='.' ) - if ( mp->char_class[mp->buffer[loc+1]]==digit_class ) - goto DONE; -f=0; -goto FIN_NUMERIC_TOKEN; -DONE: incr(loc) - -@ @<Get the fraction part |f| of a numeric token@>= -k=0; -do { - if ( k<17 ) { /* digits for |k>=17| cannot affect the result */ - mp->dig[k]=mp->buffer[loc]-'0'; incr(k); - } - incr(loc); -} while (mp->char_class[mp->buffer[loc]]==digit_class); -f=mp_round_decimals(mp, k); -if ( f==unity ) { - incr(n); f=0; -} - -@ @<Pack the numeric and fraction parts of a numeric token and |return|@>= -if ( n<32768 ) { - @<Set |cur_mod:=n*unity+f| and check if it is uncomfortably large@>; -} else if ( mp->scanner_status!=tex_flushing ) { - print_err("Enormous number has been reduced"); -@.Enormous number...@> - help2("I can\'t handle numbers bigger than 32767.99998;", - "so I've changed your constant to that maximum amount."); - mp->deletions_allowed=false; mp_error(mp); mp->deletions_allowed=true; - mp->cur_mod=el_gordo; -} -mp->cur_cmd=numeric_token; return - -@ @<Set |cur_mod:=n*unity+f| and check if it is uncomfortably large@>= -{ - mp->cur_mod=n*unity+f; - if ( mp->cur_mod>=fraction_one ) { - if ( (mp->internal[mp_warning_check]>0) && - (mp->scanner_status!=tex_flushing) ) { - print_err("Number is too large ("); - mp_print_scaled(mp, mp->cur_mod); - mp_print_char(mp, xord(')')); - help3("It is at least 4096. Continue and I'll try to cope", - "with that big value; but it might be dangerous.", - "(Set warningcheck:=0 to suppress this message.)"); - mp_error(mp); - } - } -} - -@ Let's consider now what happens when |get_next| is looking at a token list. -@^inner loop@> - -@<Input from token list;...@>= -if ( loc>=mp->hi_mem_min ) { /* one-word token */ - mp->cur_sym=mp_info(loc); loc=mp_link(loc); /* move to next */ - if ( mp->cur_sym>=expr_base ) { - if ( mp->cur_sym>=suffix_base ) { - @<Insert a suffix or text parameter and |goto restart|@>; - } else { - mp->cur_cmd=capsule_token; - mp->cur_mod=mp->param_stack[param_start+mp->cur_sym-(expr_base)]; - mp->cur_sym=0; return; - } - } -} else if ( loc>null ) { - @<Get a stored numeric or string or capsule token and |return|@> -} else { /* we are done with this token list */ - mp_end_token_list(mp); goto RESTART; /* resume previous level */ -} - -@ @<Insert a suffix or text parameter...@>= -{ - if ( mp->cur_sym>=text_base ) mp->cur_sym=mp->cur_sym-mp->param_size; - /* |param_size=text_base-suffix_base| */ - mp_begin_token_list(mp, - mp->param_stack[param_start+mp->cur_sym-(suffix_base)], - parameter); - goto RESTART; -} - -@ @<Get a stored numeric or string or capsule token...@>= -{ - if ( mp_name_type(loc)==mp_token ) { - mp->cur_mod=value(loc); - if ( mp_type(loc)==mp_known ) { - mp->cur_cmd=numeric_token; - } else { - mp->cur_cmd=string_token; add_str_ref(mp->cur_mod); - } - } else { - mp->cur_mod=loc; mp->cur_cmd=capsule_token; - }; - loc=mp_link(loc); return; -} - -@ All of the easy branches of |get_next| have now been taken care of. -There is one more branch. - -@<Move to next line of file, or |goto restart|...@>= -if ( name>max_spec_src) { - @<Read next line of file into |buffer|, or - |goto restart| if the file has ended@>; -} else { - if ( mp->input_ptr>0 ) { - /* text was inserted during error recovery or by \&{scantokens} */ - mp_end_file_reading(mp); goto RESTART; /* resume previous level */ - } - if (mp->job_name == NULL && ( mp->selector<log_only || mp->selector>=write_file)) - mp_open_log_file(mp); - if ( mp->interaction>mp_nonstop_mode ) { - if ( limit==start ) /* previous line was empty */ - mp_print_nl(mp, "(Please type a command or say `end')"); -@.Please type...@> - mp_print_ln(mp); mp->first=(size_t)start; - prompt_input("*"); /* input on-line into |buffer| */ -@.*\relax@> - limit=(halfword)mp->last; mp->buffer[limit]=xord('%'); - mp->first=(size_t)(limit+1); loc=start; - } else { - mp_fatal_error(mp, "*** (job aborted, no legal end found)"); -@.job aborted@> - /* nonstop mode, which is intended for overnight batch processing, - never waits for on-line input */ - } -} - -@ The global variable |force_eof| is normally |false|; it is set |true| -by an \&{endinput} command. - -@<Glob...@>= -boolean force_eof; /* should the next \&{input} be aborted early? */ - -@ We must decrement |loc| in order to leave the buffer in a valid state -when an error condition causes us to |goto restart| without calling -|end_file_reading|. - -@<Read next line of file into |buffer|, or - |goto restart| if the file has ended@>= -{ - incr(line); mp->first=(size_t)start; - if ( ! mp->force_eof ) { - if ( mp_input_ln(mp, cur_file ) ) /* not end of file */ - mp_firm_up_the_line(mp); /* this sets |limit| */ - else - mp->force_eof=true; - }; - if ( mp->force_eof ) { - mp->force_eof=false; - decr(loc); - if ( mpx_reading ) { - @<Complain that the \.{MPX} file ended unexpectly; then set - |cur_sym:=frozen_mpx_break| and |goto comon_ending|@>; - } else { - mp_print_char(mp, xord(')')); decr(mp->open_parens); - update_terminal; /* show user that file has been read */ - mp_end_file_reading(mp); /* resume previous level */ - if ( mp_check_outer_validity(mp) ) goto RESTART; - else goto RESTART; - } - } - mp->buffer[limit]=xord('%'); mp->first=(size_t)(limit+1); loc=start; /* ready to read */ -} - -@ We should never actually come to the end of an \.{MPX} file because such -files should have an \&{mpxbreak} after the translation of the last -\&{btex}$\,\ldots\,$\&{etex} block. - -@<Complain that the \.{MPX} file ended unexpectly; then set...@>= -{ - mp->mpx_name[iindex]=mpx_finished; - print_err("mpx file ended unexpectedly"); - help4("The file had too few picture expressions for btex...etex", - "blocks. Such files are normally generated automatically", - "but this one got messed up. You might want to insert a", - "picture expression now."); - mp->deletions_allowed=false; mp_error(mp); mp->deletions_allowed=true; - mp->cur_sym=frozen_mpx_break; goto COMMON_ENDING; -} - -@ Sometimes we want to make it look as though we have just read a blank line -without really doing so. - -@<Put an empty line in the input buffer@>= -mp->last=mp->first; limit=(halfword)mp->last; - /* simulate |input_ln| and |firm_up_the_line| */ -mp->buffer[limit]=xord('%'); mp->first=(size_t)(limit+1); loc=start - -@ If the user has set the |mp_pausing| parameter to some positive value, -and if nonstop mode has not been selected, each line of input is displayed -on the terminal and the transcript file, followed by `\.{=>}'. -\MP\ waits for a response. If the response is null (i.e., if nothing is -typed except perhaps a few blank spaces), the original -line is accepted as it stands; otherwise the line typed is -used instead of the line in the file. - -@c void mp_firm_up_the_line (MP mp) { - size_t k; /* an index into |buffer| */ - limit=(halfword)mp->last; - if ((!mp->noninteractive) - && (mp->internal[mp_pausing]>0 ) - && (mp->interaction>mp_nonstop_mode )) { - wake_up_terminal; mp_print_ln(mp); - if ( start<limit ) { - for (k=(size_t)start;k<(size_t)limit;k++) { - mp_print_str(mp, mp->buffer[k]); - } - } - mp->first=(size_t)limit; prompt_input("=>"); /* wait for user response */ -@.=>@> - if ( mp->last>mp->first ) { - for (k=mp->first;k<mp->last;k++) { /* move line down in buffer */ - mp->buffer[k+start-mp->first]=mp->buffer[k]; - } - limit=(halfword)(start+mp->last-mp->first); - } - } -} - -@* \[30] Dealing with \TeX\ material. -The \&{btex}$\,\ldots\,$\&{etex} and \&{verbatimtex}$\,\ldots\,$\&{etex} -features need to be implemented at a low level in the scanning process -so that \MP\ can stay in synch with the a preprocessor that treats -blocks of \TeX\ material as they occur in the input file without trying -to expand \MP\ macros. Thus we need a special version of |get_next| -that does not expand macros and such but does handle \&{btex}, -\&{verbatimtex}, etc. - -The special version of |get_next| is called |get_t_next|. It works by flushing -\&{btex}$\,\ldots\,$\&{etex} and \&{verbatimtex}\allowbreak -$\,\ldots\,$\&{etex} blocks, switching to the \.{MPX} file when it sees -\&{btex}, and switching back when it sees \&{mpxbreak}. - -@d btex_code 0 -@d verbatim_code 1 - -@ @<Put each...@>= -mp_primitive(mp, "btex",start_tex,btex_code); -@:btex_}{\&{btex} primitive@> -mp_primitive(mp, "verbatimtex",start_tex,verbatim_code); -@:verbatimtex_}{\&{verbatimtex} primitive@> -mp_primitive(mp, "etex",etex_marker,0); mp->eqtb[frozen_etex]=mp->eqtb[mp->cur_sym]; -@:etex_}{\&{etex} primitive@> -mp_primitive(mp, "mpxbreak",mpx_break,0); mp->eqtb[frozen_mpx_break]=mp->eqtb[mp->cur_sym]; -@:mpx_break_}{\&{mpxbreak} primitive@> - -@ @<Cases of |print_cmd...@>= -case start_tex: if ( m==btex_code ) mp_print(mp, "btex"); - else mp_print(mp, "verbatimtex"); break; -case etex_marker: mp_print(mp, "etex"); break; -case mpx_break: mp_print(mp, "mpxbreak"); break; - -@ Actually, |get_t_next| is a macro that avoids procedure overhead except -in the unusual case where \&{btex}, \&{verbatimtex}, \&{etex}, or \&{mpxbreak} -is encountered. - -@d get_t_next {mp_get_next(mp); if ( mp->cur_cmd<=max_pre_command ) mp_t_next(mp); } - -@<Declarations@>= -static void mp_start_mpx_input (MP mp); - -@ @c -static void mp_t_next (MP mp) { - int old_status; /* saves the |scanner_status| */ - integer old_info; /* saves the |warning_info| */ - while ( mp->cur_cmd<=max_pre_command ) { - if ( mp->cur_cmd==mpx_break ) { - if ( ! file_state || (mp->mpx_name[iindex]==absent) ) { - @<Complain about a misplaced \&{mpxbreak}@>; - } else { - mp_end_mpx_reading(mp); - goto TEX_FLUSH; - } - } else if ( mp->cur_cmd==start_tex ) { - if ( token_state || (name<=max_spec_src) ) { - @<Complain that we are not reading a file@>; - } else if ( mpx_reading ) { - @<Complain that \.{MPX} files cannot contain \TeX\ material@>; - } else if ( (mp->cur_mod!=verbatim_code)&& - (mp->mpx_name[iindex]!=mpx_finished) ) { - if ( ! mp_begin_mpx_reading(mp) ) mp_start_mpx_input(mp); - } else { - goto TEX_FLUSH; - } - } else { - @<Complain about a misplaced \&{etex}@>; - } - goto COMMON_ENDING; - TEX_FLUSH: - @<Flush the \TeX\ material@>; - COMMON_ENDING: - mp_get_next(mp); - } -} - -@ We could be in the middle of an operation such as skipping false conditional -text when \TeX\ material is encountered, so we must be careful to save the -|scanner_status|. - -@<Flush the \TeX\ material@>= -old_status=mp->scanner_status; -old_info=mp->warning_info; -mp->scanner_status=tex_flushing; -mp->warning_info=line; -do { mp_get_next(mp); } while (mp->cur_cmd!=etex_marker); -mp->scanner_status=old_status; -mp->warning_info=old_info - -@ @<Complain that \.{MPX} files cannot contain \TeX\ material@>= -{ print_err("An mpx file cannot contain btex or verbatimtex blocks"); -help4("This file contains picture expressions for btex...etex", - "blocks. Such files are normally generated automatically", - "but this one seems to be messed up. I'll just keep going", - "and hope for the best."); -mp_error(mp); -} - -@ @<Complain that we are not reading a file@>= -{ print_err("You can only use `btex' or `verbatimtex' in a file"); -help3("I'll have to ignore this preprocessor command because it", - "only works when there is a file to preprocess. You might", - "want to delete everything up to the next `etex`."); -mp_error(mp); -} - -@ @<Complain about a misplaced \&{mpxbreak}@>= -{ print_err("Misplaced mpxbreak"); -help2("I'll ignore this preprocessor command because it", - "doesn't belong here"); -mp_error(mp); -} - -@ @<Complain about a misplaced \&{etex}@>= -{ print_err("Extra etex will be ignored"); -help1("There is no btex or verbatimtex for this to match"); -mp_error(mp); -} - -@* \[31] Scanning macro definitions. -\MP\ has a variety of ways to tuck tokens away into token lists for later -use: Macros can be defined with \&{def}, \&{vardef}, \&{primarydef}, etc.; -repeatable code can be defined with \&{for}, \&{forever}, \&{forsuffixes}. -All such operations are handled by the routines in this part of the program. - -The modifier part of each command code is zero for the ``ending delimiters'' -like \&{enddef} and \&{endfor}. - -@d start_def 1 /* command modifier for \&{def} */ -@d var_def 2 /* command modifier for \&{vardef} */ -@d end_def 0 /* command modifier for \&{enddef} */ -@d start_forever 1 /* command modifier for \&{forever} */ -@d end_for 0 /* command modifier for \&{endfor} */ - -@<Put each...@>= -mp_primitive(mp, "def",macro_def,start_def); -@:def_}{\&{def} primitive@> -mp_primitive(mp, "vardef",macro_def,var_def); -@:var_def_}{\&{vardef} primitive@> -mp_primitive(mp, "primarydef",macro_def,secondary_primary_macro); -@:primary_def_}{\&{primarydef} primitive@> -mp_primitive(mp, "secondarydef",macro_def,tertiary_secondary_macro); -@:secondary_def_}{\&{secondarydef} primitive@> -mp_primitive(mp, "tertiarydef",macro_def,expression_tertiary_macro); -@:tertiary_def_}{\&{tertiarydef} primitive@> -mp_primitive(mp, "enddef",macro_def,end_def); mp->eqtb[frozen_end_def]=mp->eqtb[mp->cur_sym]; -@:end_def_}{\&{enddef} primitive@> -@# -mp_primitive(mp, "for",iteration,expr_base); -@:for_}{\&{for} primitive@> -mp_primitive(mp, "forsuffixes",iteration,suffix_base); -@:for_suffixes_}{\&{forsuffixes} primitive@> -mp_primitive(mp, "forever",iteration,start_forever); -@:forever_}{\&{forever} primitive@> -mp_primitive(mp, "endfor",iteration,end_for); mp->eqtb[frozen_end_for]=mp->eqtb[mp->cur_sym]; -@:end_for_}{\&{endfor} primitive@> - -@ @<Cases of |print_cmd...@>= -case macro_def: - if ( m<=var_def ) { - if ( m==start_def ) mp_print(mp, "def"); - else if ( m<start_def ) mp_print(mp, "enddef"); - else mp_print(mp, "vardef"); - } else if ( m==secondary_primary_macro ) { - mp_print(mp, "primarydef"); - } else if ( m==tertiary_secondary_macro ) { - mp_print(mp, "secondarydef"); - } else { - mp_print(mp, "tertiarydef"); - } - break; -case iteration: - if ( m<=start_forever ) { - if ( m==start_forever ) mp_print(mp, "forever"); - else mp_print(mp, "endfor"); - } else if ( m==expr_base ) { - mp_print(mp, "for"); - } else { - mp_print(mp, "forsuffixes"); - } - break; - -@ Different macro-absorbing operations have different syntaxes, but they -also have a lot in common. There is a list of special symbols that are to -be replaced by parameter tokens; there is a special command code that -ends the definition; the quotation conventions are identical. Therefore -it makes sense to have most of the work done by a single subroutine. That -subroutine is called |scan_toks|. - -The first parameter to |scan_toks| is the command code that will -terminate scanning (either |macro_def| or |iteration|). - -The second parameter, |subst_list|, points to a (possibly empty) list -of two-word nodes whose |info| and |value| fields specify symbol tokens -before and after replacement. The list will be returned to free storage -by |scan_toks|. - -The third parameter is simply appended to the token list that is built. -And the final parameter tells how many of the special operations -\.{\#\AT!}, \.{\AT!}, and \.{\AT!\#} are to be replaced by suffix parameters. -When such parameters are present, they are called \.{(SUFFIX0)}, -\.{(SUFFIX1)}, and \.{(SUFFIX2)}. - -@c static pointer mp_scan_toks (MP mp,command_code terminator, pointer - subst_list, pointer tail_end, quarterword suffix_count) { - pointer p; /* tail of the token list being built */ - pointer q; /* temporary for link management */ - integer balance; /* left delimiters minus right delimiters */ - p=hold_head; balance=1; mp_link(hold_head)=null; - while (1) { - get_t_next; - if ( mp->cur_sym>0 ) { - @<Substitute for |cur_sym|, if it's on the |subst_list|@>; - if ( mp->cur_cmd==terminator ) { - @<Adjust the balance; |break| if it's zero@>; - } else if ( mp->cur_cmd==macro_special ) { - @<Handle quoted symbols, \.{\#\AT!}, \.{\AT!}, or \.{\AT!\#}@>; - } - } - mp_link(p)=mp_cur_tok(mp); p=mp_link(p); - } - mp_link(p)=tail_end; mp_flush_node_list(mp, subst_list); - return mp_link(hold_head); -} - -@ @<Substitute for |cur_sym|...@>= -{ - q=subst_list; - while ( q!=null ) { - if ( mp_info(q)==mp->cur_sym ) { - mp->cur_sym=value(q); mp->cur_cmd=relax; break; - } - q=mp_link(q); - } -} - -@ @<Adjust the balance; |break| if it's zero@>= -if ( mp->cur_mod>0 ) { - incr(balance); -} else { - decr(balance); - if ( balance==0 ) - break; -} - -@ Four commands are intended to be used only within macro texts: \&{quote}, -\.{\#\AT!}, \.{\AT!}, and \.{\AT!\#}. They are variants of a single command -code called |macro_special|. - -@d quote 0 /* |macro_special| modifier for \&{quote} */ -@d macro_prefix 1 /* |macro_special| modifier for \.{\#\AT!} */ -@d macro_at 2 /* |macro_special| modifier for \.{\AT!} */ -@d macro_suffix 3 /* |macro_special| modifier for \.{\AT!\#} */ - -@<Put each...@>= -mp_primitive(mp, "quote",macro_special,quote); -@:quote_}{\&{quote} primitive@> -mp_primitive(mp, "#@@",macro_special,macro_prefix); -@:]]]\#\AT!_}{\.{\#\AT!} primitive@> -mp_primitive(mp, "@@",macro_special,macro_at); -@:]]]\AT!_}{\.{\AT!} primitive@> -mp_primitive(mp, "@@#",macro_special,macro_suffix); -@:]]]\AT!\#_}{\.{\AT!\#} primitive@> - -@ @<Cases of |print_cmd...@>= -case macro_special: - switch (m) { - case macro_prefix: mp_print(mp, "#@@"); break; - case macro_at: mp_print_char(mp, xord('@@')); break; - case macro_suffix: mp_print(mp, "@@#"); break; - default: mp_print(mp, "quote"); break; - } - break; - -@ @<Handle quoted...@>= -{ - if ( mp->cur_mod==quote ) { get_t_next; } - else if ( mp->cur_mod<=suffix_count ) - mp->cur_sym=suffix_base-1+mp->cur_mod; -} - -@ Here is a routine that's used whenever a token will be redefined. If -the user's token is unredefinable, the `|frozen_inaccessible|' token is -substituted; the latter is redefinable but essentially impossible to use, -hence \MP's tables won't get fouled up. - -@c static void mp_get_symbol (MP mp) { /* sets |cur_sym| to a safe symbol */ -RESTART: - get_t_next; - if ( (mp->cur_sym==0)||(mp->cur_sym>(integer)frozen_inaccessible) ) { - print_err("Missing symbolic token inserted"); -@.Missing symbolic token...@> - help3("Sorry: You can\'t redefine a number, string, or expr.", - "I've inserted an inaccessible symbol so that your", - "definition will be completed without mixing me up too badly."); - if ( mp->cur_sym>0 ) - mp->help_line[2]="Sorry: You can\'t redefine my error-recovery tokens."; - else if ( mp->cur_cmd==string_token ) - delete_str_ref(mp->cur_mod); - mp->cur_sym=frozen_inaccessible; mp_ins_error(mp); goto RESTART; - } -} - -@ Before we actually redefine a symbolic token, we need to clear away its -former value, if it was a variable. The following stronger version of -|get_symbol| does that. - -@c static void mp_get_clear_symbol (MP mp) { - mp_get_symbol(mp); mp_clear_symbol(mp, mp->cur_sym,false); -} - -@ Here's another little subroutine; it checks that an equals sign -or assignment sign comes along at the proper place in a macro definition. - -@c static void mp_check_equals (MP mp) { - if ( mp->cur_cmd!=equals ) if ( mp->cur_cmd!=assignment ) { - mp_missing_err(mp, "="); -@.Missing `='@> - help5("The next thing in this `def' should have been `=',", - "because I've already looked at the definition heading.", - "But don't worry; I'll pretend that an equals sign", - "was present. Everything from here to `enddef'", - "will be the replacement text of this macro."); - mp_back_error(mp); - } -} - -@ A \&{primarydef}, \&{secondarydef}, or \&{tertiarydef} is rather easily -handled now that we have |scan_toks|. In this case there are -two parameters, which will be \.{EXPR0} and \.{EXPR1} (i.e., -|expr_base| and |expr_base+1|). - -@c static void mp_make_op_def (MP mp) { - command_code m; /* the type of definition */ - pointer p,q,r; /* for list manipulation */ - m=mp->cur_mod; - mp_get_symbol(mp); q=mp_get_node(mp, token_node_size); - mp_info(q)=mp->cur_sym; value(q)=expr_base; - mp_get_clear_symbol(mp); mp->warning_info=mp->cur_sym; - mp_get_symbol(mp); p=mp_get_node(mp, token_node_size); - mp_info(p)=mp->cur_sym; value(p)=expr_base+1; mp_link(p)=q; - get_t_next; mp_check_equals(mp); - mp->scanner_status=op_defining; q=mp_get_avail(mp); ref_count(q)=null; - r=mp_get_avail(mp); mp_link(q)=r; mp_info(r)=general_macro; - mp_link(r)=mp_scan_toks(mp, macro_def,p,null,0); - mp->scanner_status=normal; eq_type(mp->warning_info)=m; - equiv(mp->warning_info)=q; mp_get_x_next(mp); -} - -@ Parameters to macros are introduced by the keywords \&{expr}, -\&{suffix}, \&{text}, \&{primary}, \&{secondary}, and \&{tertiary}. - -@<Put each...@>= -mp_primitive(mp, "expr",param_type,expr_base); -@:expr_}{\&{expr} primitive@> -mp_primitive(mp, "suffix",param_type,suffix_base); -@:suffix_}{\&{suffix} primitive@> -mp_primitive(mp, "text",param_type,text_base); -@:text_}{\&{text} primitive@> -mp_primitive(mp, "primary",param_type,primary_macro); -@:primary_}{\&{primary} primitive@> -mp_primitive(mp, "secondary",param_type,secondary_macro); -@:secondary_}{\&{secondary} primitive@> -mp_primitive(mp, "tertiary",param_type,tertiary_macro); -@:tertiary_}{\&{tertiary} primitive@> - -@ @<Cases of |print_cmd...@>= -case param_type: - if ( m>=expr_base ) { - if ( m==expr_base ) mp_print(mp, "expr"); - else if ( m==suffix_base ) mp_print(mp, "suffix"); - else mp_print(mp, "text"); - } else if ( m<secondary_macro ) { - mp_print(mp, "primary"); - } else if ( m==secondary_macro ) { - mp_print(mp, "secondary"); - } else { - mp_print(mp, "tertiary"); - } - break; - -@ Let's turn next to the more complex processing associated with \&{def} -and \&{vardef}. When the following procedure is called, |cur_mod| -should be either |start_def| or |var_def|. - -@c -static void mp_scan_def (MP mp) { - int m; /* the type of definition */ - int n; /* the number of special suffix parameters */ - int k; /* the total number of parameters */ - int c; /* the kind of macro we're defining */ - pointer r; /* parameter-substitution list */ - pointer q; /* tail of the macro token list */ - pointer p; /* temporary storage */ - halfword base; /* |expr_base|, |suffix_base|, or |text_base| */ - pointer l_delim,r_delim; /* matching delimiters */ - m=mp->cur_mod; c=general_macro; mp_link(hold_head)=null; - q=mp_get_avail(mp); ref_count(q)=null; r=null; - @<Scan the token or variable to be defined; - set |n|, |scanner_status|, and |warning_info|@>; - k=n; - if ( mp->cur_cmd==left_delimiter ) { - @<Absorb delimited parameters, putting them into lists |q| and |r|@>; - } - if ( mp->cur_cmd==param_type ) { - @<Absorb undelimited parameters, putting them into list |r|@>; - } - mp_check_equals(mp); - p=mp_get_avail(mp); mp_info(p)=c; mp_link(q)=p; - @<Attach the replacement text to the tail of node |p|@>; - mp->scanner_status=normal; mp_get_x_next(mp); -} - -@ We don't put `|frozen_end_group|' into the replacement text of -a \&{vardef}, because the user may want to redefine `\.{endgroup}'. - -@<Attach the replacement text to the tail of node |p|@>= -if ( m==start_def ) { - mp_link(p)=mp_scan_toks(mp, macro_def,r,null,n); -} else { - q=mp_get_avail(mp); mp_info(q)=mp->bg_loc; mp_link(p)=q; - p=mp_get_avail(mp); mp_info(p)=mp->eg_loc; - mp_link(q)=mp_scan_toks(mp, macro_def,r,p,n); -} -if ( mp->warning_info==bad_vardef ) - mp_flush_token_list(mp, value(bad_vardef)) - -@ @<Glob...@>= -int bg_loc; -int eg_loc; /* hash addresses of `\.{begingroup}' and `\.{endgroup}' */ - -@ @<Scan the token or variable to be defined;...@>= -if ( m==start_def ) { - mp_get_clear_symbol(mp); mp->warning_info=mp->cur_sym; get_t_next; - mp->scanner_status=op_defining; n=0; - eq_type(mp->warning_info)=defined_macro; equiv(mp->warning_info)=q; -} else { - p=mp_scan_declared_variable(mp); - mp_flush_variable(mp, equiv(mp_info(p)),mp_link(p),true); - mp->warning_info=mp_find_variable(mp, p); mp_flush_list(mp, p); - if ( mp->warning_info==null ) @<Change to `\.{a bad variable}'@>; - mp->scanner_status=var_defining; n=2; - if ( mp->cur_cmd==macro_special ) if ( mp->cur_mod==macro_suffix ) {/* \.{\AT!\#} */ - n=3; get_t_next; - } - mp_type(mp->warning_info)=mp_unsuffixed_macro-2+n; value(mp->warning_info)=q; -} /* |mp_suffixed_macro=mp_unsuffixed_macro+1| */ - -@ @<Change to `\.{a bad variable}'@>= -{ - print_err("This variable already starts with a macro"); -@.This variable already...@> - help2("After `vardef a' you can\'t say `vardef a.b'.", - "So I'll have to discard this definition."); - mp_error(mp); mp->warning_info=bad_vardef; -} - -@ @<Initialize table entries...@>= -mp_name_type(bad_vardef)=mp_root; mp_link(bad_vardef)=frozen_bad_vardef; -equiv(frozen_bad_vardef)=bad_vardef; eq_type(frozen_bad_vardef)=tag_token; - -@ @<Absorb delimited parameters, putting them into lists |q| and |r|@>= -do { - l_delim=mp->cur_sym; r_delim=mp->cur_mod; get_t_next; - if ( (mp->cur_cmd==param_type)&&(mp->cur_mod>=expr_base) ) { - base=mp->cur_mod; - } else { - print_err("Missing parameter type; `expr' will be assumed"); -@.Missing parameter type@> - help1("You should've had `expr' or `suffix' or `text' here."); - mp_back_error(mp); base=expr_base; - } - @<Absorb parameter tokens for type |base|@>; - mp_check_delimiter(mp, l_delim,r_delim); - get_t_next; -} while (mp->cur_cmd==left_delimiter) - -@ @<Absorb parameter tokens for type |base|@>= -do { - mp_link(q)=mp_get_avail(mp); q=mp_link(q); mp_info(q)=base+k; - mp_get_symbol(mp); p=mp_get_node(mp, token_node_size); - value(p)=base+k; mp_info(p)=mp->cur_sym; - if ( k==mp->param_size ) mp_overflow(mp, "parameter stack size",mp->param_size); -@:MetaPost capacity exceeded parameter stack size}{\quad parameter stack size@> - incr(k); mp_link(p)=r; r=p; get_t_next; -} while (mp->cur_cmd==comma) - -@ @<Absorb undelimited parameters, putting them into list |r|@>= -{ - p=mp_get_node(mp, token_node_size); - if ( mp->cur_mod<expr_base ) { - c=mp->cur_mod; value(p)=expr_base+k; - } else { - value(p)=mp->cur_mod+k; - if ( mp->cur_mod==expr_base ) c=expr_macro; - else if ( mp->cur_mod==suffix_base ) c=suffix_macro; - else c=text_macro; - } - if ( k==mp->param_size ) mp_overflow(mp, "parameter stack size",mp->param_size); - incr(k); mp_get_symbol(mp); mp_info(p)=mp->cur_sym; mp_link(p)=r; r=p; get_t_next; - if ( c==expr_macro ) if ( mp->cur_cmd==of_token ) { - c=of_macro; p=mp_get_node(mp, token_node_size); - if ( k==mp->param_size ) mp_overflow(mp, "parameter stack size",mp->param_size); - value(p)=expr_base+k; mp_get_symbol(mp); mp_info(p)=mp->cur_sym; - mp_link(p)=r; r=p; get_t_next; - } -} - -@* \[32] Expanding the next token. -Only a few command codes |<min_command| can possibly be returned by -|get_t_next|; in increasing order, they are -|if_test|, |fi_or_else|, |input|, |iteration|, |repeat_loop|, -|exit_test|, |relax|, |scan_tokens|, |expand_after|, and |defined_macro|. - -\MP\ usually gets the next token of input by saying |get_x_next|. This is -like |get_t_next| except that it keeps getting more tokens until -finding |cur_cmd>=min_command|. In other words, |get_x_next| expands -macros and removes conditionals or iterations or input instructions that -might be present. - -It follows that |get_x_next| might invoke itself recursively. In fact, -there is massive recursion, since macro expansion can involve the -scanning of arbitrarily complex expressions, which in turn involve -macro expansion and conditionals, etc. -@^recursion@> - -Therefore it's necessary to declare a whole bunch of |forward| -procedures at this point, and to insert some other procedures -that will be invoked by |get_x_next|. - -@<Declarations@>= -static void mp_scan_primary (MP mp); -static void mp_scan_secondary (MP mp); -static void mp_scan_tertiary (MP mp); -static void mp_scan_expression (MP mp); -static void mp_scan_suffix (MP mp); -static void mp_get_boolean (MP mp); -static void mp_pass_text (MP mp); -static void mp_conditional (MP mp); -static void mp_start_input (MP mp); -static void mp_begin_iteration (MP mp); -static void mp_resume_iteration (MP mp); -static void mp_stop_iteration (MP mp); - -@ An auxiliary subroutine called |expand| is used by |get_x_next| -when it has to do exotic expansion commands. - -@c -static void mp_expand (MP mp) { - pointer p; /* for list manipulation */ - size_t k; /* something that we hope is |<=buf_size| */ - pool_pointer j; /* index into |str_pool| */ - if ( mp->internal[mp_tracing_commands]>unity ) - if ( mp->cur_cmd!=defined_macro ) - show_cur_cmd_mod; - switch (mp->cur_cmd) { - case if_test: - mp_conditional(mp); /* this procedure is discussed in Part 36 below */ - break; - case fi_or_else: - @<Terminate the current conditional and skip to \&{fi}@>; - break; - case input: - @<Initiate or terminate input from a file@>; - break; - case iteration: - if ( mp->cur_mod==end_for ) { - @<Scold the user for having an extra \&{endfor}@>; - } else { - mp_begin_iteration(mp); /* this procedure is discussed in Part 37 below */ - } - break; - case repeat_loop: - @<Repeat a loop@>; - break; - case exit_test: - @<Exit a loop if the proper time has come@>; - break; - case relax: - break; - case expand_after: - @<Expand the token after the next token@>; - break; - case scan_tokens: - @<Put a string into the input buffer@>; - break; - case defined_macro: - mp_macro_call(mp, mp->cur_mod,null,mp->cur_sym); - break; - }; /* there are no other cases */ -} - -@ @<Scold the user...@>= -{ - print_err("Extra `endfor'"); -@.Extra `endfor'@> - help2("I'm not currently working on a for loop,", - "so I had better not try to end anything."); - mp_error(mp); -} - -@ The processing of \&{input} involves the |start_input| subroutine, -which will be declared later; the processing of \&{endinput} is trivial. - -@<Put each...@>= -mp_primitive(mp, "input",input,0); -@:input_}{\&{input} primitive@> -mp_primitive(mp, "endinput",input,1); -@:end_input_}{\&{endinput} primitive@> - -@ @<Cases of |print_cmd_mod|...@>= -case input: - if ( m==0 ) mp_print(mp, "input"); - else mp_print(mp, "endinput"); - break; - -@ @<Initiate or terminate input...@>= -if ( mp->cur_mod>0 ) mp->force_eof=true; -else mp_start_input(mp) - -@ We'll discuss the complicated parts of loop operations later. For now -it suffices to know that there's a global variable called |loop_ptr| -that will be |null| if no loop is in progress. - -@<Repeat a loop@>= -{ while ( token_state &&(loc==null) ) - mp_end_token_list(mp); /* conserve stack space */ - if ( mp->loop_ptr==null ) { - print_err("Lost loop"); -@.Lost loop@> - help2("I'm confused; after exiting from a loop, I still seem", - "to want to repeat it. I'll try to forget the problem."); - mp_error(mp); - } else { - mp_resume_iteration(mp); /* this procedure is in Part 37 below */ - } -} - -@ @<Exit a loop if the proper time has come@>= -{ mp_get_boolean(mp); - if ( mp->internal[mp_tracing_commands]>unity ) - mp_show_cmd_mod(mp, nullary,mp->cur_exp); - if ( mp->cur_exp==true_code ) { - if ( mp->loop_ptr==null ) { - print_err("No loop is in progress"); -@.No loop is in progress@> - help1("Why say `exitif' when there's nothing to exit from?"); - if ( mp->cur_cmd==semicolon ) mp_error(mp); else mp_back_error(mp); - } else { - @<Exit prematurely from an iteration@>; - } - } else if ( mp->cur_cmd!=semicolon ) { - mp_missing_err(mp, ";"); -@.Missing `;'@> - help2("After `exitif <boolean exp>' I expect to see a semicolon.", - "I shall pretend that one was there."); mp_back_error(mp); - } -} - -@ Here we use the fact that |forever_text| is the only |token_type| that -is less than |loop_text|. - -@<Exit prematurely...@>= -{ p=null; - do { - if ( file_state ) { - mp_end_file_reading(mp); - } else { - if ( token_type<=loop_text ) p=start; - mp_end_token_list(mp); - } - } while (p==null); - if ( p!=mp_info(mp->loop_ptr) ) mp_fatal_error(mp, "*** (loop confusion)"); -@.loop confusion@> - mp_stop_iteration(mp); /* this procedure is in Part 34 below */ -} - -@ @<Expand the token after the next token@>= -{ get_t_next; - p=mp_cur_tok(mp); get_t_next; - if ( mp->cur_cmd<min_command ) mp_expand(mp); - else mp_back_input(mp); - back_list(p); -} - -@ @<Put a string into the input buffer@>= -{ mp_get_x_next(mp); mp_scan_primary(mp); - if ( mp->cur_type!=mp_string_type ) { - mp_disp_err(mp, null,"Not a string"); -@.Not a string@> - help2("I'm going to flush this expression, since", - "scantokens should be followed by a known string."); - mp_put_get_flush_error(mp, 0); - } else { - mp_back_input(mp); - if ( length(mp->cur_exp)>0 ) - @<Pretend we're reading a new one-line file@>; - } -} - -@ @<Pretend we're reading a new one-line file@>= -{ mp_begin_file_reading(mp); name=is_scantok; - k=mp->first+length(mp->cur_exp); - if ( k>=mp->max_buf_stack ) { - while ( k>=mp->buf_size ) { - mp_reallocate_buffer(mp,(mp->buf_size+(mp->buf_size/4))); - } - mp->max_buf_stack=k+1; - } - j=mp->str_start[mp->cur_exp]; limit=(halfword)k; - while ( mp->first<(size_t)limit ) { - mp->buffer[mp->first]=mp->str_pool[j]; incr(j); incr(mp->first); - } - mp->buffer[limit]=xord('%'); mp->first=(size_t)(limit+1); loc=start; - mp_flush_cur_exp(mp, 0); -} - -@ Here finally is |get_x_next|. - -The expression scanning routines to be considered later -communicate via the global quantities |cur_type| and |cur_exp|; -we must be very careful to save and restore these quantities while -macros are being expanded. -@^inner loop@> - -@<Declarations@>= -static void mp_get_x_next (MP mp); - -@ @c void mp_get_x_next (MP mp) { - pointer save_exp; /* a capsule to save |cur_type| and |cur_exp| */ - get_t_next; - if ( mp->cur_cmd<min_command ) { - save_exp=mp_stash_cur_exp(mp); - do { - if ( mp->cur_cmd==defined_macro ) - mp_macro_call(mp, mp->cur_mod,null,mp->cur_sym); - else - mp_expand(mp); - get_t_next; - } while (mp->cur_cmd<min_command); - mp_unstash_cur_exp(mp, save_exp); /* that restores |cur_type| and |cur_exp| */ - } -} - -@ Now let's consider the |macro_call| procedure, which is used to start up -all user-defined macros. Since the arguments to a macro might be expressions, -|macro_call| is recursive. -@^recursion@> - -The first parameter to |macro_call| points to the reference count of the -token list that defines the macro. The second parameter contains any -arguments that have already been parsed (see below). The third parameter -points to the symbolic token that names the macro. If the third parameter -is |null|, the macro was defined by \&{vardef}, so its name can be -reconstructed from the prefix and ``at'' arguments found within the -second parameter. - -What is this second parameter? It's simply a linked list of one-word items, -whose |info| fields point to the arguments. In other words, if |arg_list=null|, -no arguments have been scanned yet; otherwise |mp_info(arg_list)| points to -the first scanned argument, and |mp_link(arg_list)| points to the list of -further arguments (if any). - -Arguments of type \&{expr} are so-called capsules, which we will -discuss later when we concentrate on expressions; they can be -recognized easily because their |link| field is |void|. Arguments of type -\&{suffix} and \&{text} are token lists without reference counts. - -@ After argument scanning is complete, the arguments are moved to the -|param_stack|. (They can't be put on that stack any sooner, because -the stack is growing and shrinking in unpredictable ways as more arguments -are being acquired.) Then the macro body is fed to the scanner; i.e., -the replacement text of the macro is placed at the top of the \MP's -input stack, so that |get_t_next| will proceed to read it next. - -@<Declarations@>= -static void mp_macro_call (MP mp,pointer def_ref, pointer arg_list, - pointer macro_name) ; - -@ @c -void mp_macro_call (MP mp,pointer def_ref, pointer arg_list, - pointer macro_name) { - /* invokes a user-defined control sequence */ - pointer r; /* current node in the macro's token list */ - pointer p,q; /* for list manipulation */ - integer n; /* the number of arguments */ - pointer tail = 0; /* tail of the argument list */ - pointer l_delim=0,r_delim=0; /* a delimiter pair */ - r=mp_link(def_ref); add_mac_ref(def_ref); - if ( arg_list==null ) { - n=0; - } else { - @<Determine the number |n| of arguments already supplied, - and set |tail| to the tail of |arg_list|@>; - } - if ( mp->internal[mp_tracing_macros]>0 ) { - @<Show the text of the macro being expanded, and the existing arguments@>; - } - @<Scan the remaining arguments, if any; set |r| to the first token - of the replacement text@>; - @<Feed the arguments and replacement text to the scanner@>; -} - -@ @<Show the text of the macro...@>= -mp_begin_diagnostic(mp); mp_print_ln(mp); -mp_print_macro_name(mp, arg_list,macro_name); -if ( n==3 ) mp_print(mp, "@@#"); /* indicate a suffixed macro */ -mp_show_macro(mp, def_ref,null,100000); -if ( arg_list!=null ) { - n=0; p=arg_list; - do { - q=mp_info(p); - mp_print_arg(mp, q,n,0); - incr(n); p=mp_link(p); - } while (p!=null); -} -mp_end_diagnostic(mp, false) - - -@ @<Declarations@>= -static void mp_print_macro_name (MP mp,pointer a, pointer n); - -@ @c -void mp_print_macro_name (MP mp,pointer a, pointer n) { - pointer p,q; /* they traverse the first part of |a| */ - if ( n!=null ) { - mp_print_text(n); - } else { - p=mp_info(a); - if ( p==null ) { - mp_print_text(mp_info(mp_info(mp_link(a)))); - } else { - q=p; - while ( mp_link(q)!=null ) q=mp_link(q); - mp_link(q)=mp_info(mp_link(a)); - mp_show_token_list(mp, p,null,1000,0); - mp_link(q)=null; - } - } -} - -@ @<Declarations@>= -static void mp_print_arg (MP mp,pointer q, integer n, pointer b) ; - -@ @c -void mp_print_arg (MP mp,pointer q, integer n, pointer b) { - if ( mp_link(q)==mp_void ) mp_print_nl(mp, "(EXPR"); - else if ( (b<text_base)&&(b!=text_macro) ) mp_print_nl(mp, "(SUFFIX"); - else mp_print_nl(mp, "(TEXT"); - mp_print_int(mp, n); mp_print(mp, ")<-"); - if ( mp_link(q)==mp_void ) mp_print_exp(mp, q,1); - else mp_show_token_list(mp, q,null,1000,0); -} - -@ @<Determine the number |n| of arguments already supplied...@>= -{ - n=1; tail=arg_list; - while ( mp_link(tail)!=null ) { - incr(n); tail=mp_link(tail); - } -} - -@ @<Scan the remaining arguments, if any; set |r|...@>= -mp->cur_cmd=comma+1; /* anything |<>comma| will do */ -while ( mp_info(r)>=expr_base ) { - @<Scan the delimited argument represented by |mp_info(r)|@>; - r=mp_link(r); -} -if ( mp->cur_cmd==comma ) { - print_err("Too many arguments to "); -@.Too many arguments...@> - mp_print_macro_name(mp, arg_list,macro_name); mp_print_char(mp, xord(';')); - mp_print_nl(mp, " Missing `"); mp_print_text(r_delim); -@.Missing `)'...@> - mp_print(mp, "' has been inserted"); - help3("I'm going to assume that the comma I just read was a", - "right delimiter, and then I'll begin expanding the macro.", - "You might want to delete some tokens before continuing."); - mp_error(mp); -} -if ( mp_info(r)!=general_macro ) { - @<Scan undelimited argument(s)@>; -} -r=mp_link(r) - -@ At this point, the reader will find it advisable to review the explanation -of token list format that was presented earlier, paying special attention to -the conventions that apply only at the beginning of a macro's token list. - -On the other hand, the reader will have to take the expression-parsing -aspects of the following program on faith; we will explain |cur_type| -and |cur_exp| later. (Several things in this program depend on each other, -and it's necessary to jump into the circle somewhere.) - -@<Scan the delimited argument represented by |mp_info(r)|@>= -if ( mp->cur_cmd!=comma ) { - mp_get_x_next(mp); - if ( mp->cur_cmd!=left_delimiter ) { - print_err("Missing argument to "); -@.Missing argument...@> - mp_print_macro_name(mp, arg_list,macro_name); - help3("That macro has more parameters than you thought.", - "I'll continue by pretending that each missing argument", - "is either zero or null."); - if ( mp_info(r)>=suffix_base ) { - mp->cur_exp=null; mp->cur_type=mp_token_list; - } else { - mp->cur_exp=0; mp->cur_type=mp_known; - } - mp_back_error(mp); mp->cur_cmd=right_delimiter; - goto FOUND; - } - l_delim=mp->cur_sym; r_delim=mp->cur_mod; -} -@<Scan the argument represented by |mp_info(r)|@>; -if ( mp->cur_cmd!=comma ) - @<Check that the proper right delimiter was present@>; -FOUND: -@<Append the current expression to |arg_list|@> - -@ @<Check that the proper right delim...@>= -if ( (mp->cur_cmd!=right_delimiter)||(mp->cur_mod!=l_delim) ) { - if ( mp_info(mp_link(r))>=expr_base ) { - mp_missing_err(mp, ","); -@.Missing `,'@> - help3("I've finished reading a macro argument and am about to", - "read another; the arguments weren't delimited correctly.", - "You might want to delete some tokens before continuing."); - mp_back_error(mp); mp->cur_cmd=comma; - } else { - mp_missing_err(mp, str(text(r_delim))); -@.Missing `)'@> - help2("I've gotten to the end of the macro parameter list.", - "You might want to delete some tokens before continuing."); - mp_back_error(mp); - } -} - -@ A \&{suffix} or \&{text} parameter will have been scanned as -a token list pointed to by |cur_exp|, in which case we will have -|cur_type=token_list|. - -@<Append the current expression to |arg_list|@>= -{ - p=mp_get_avail(mp); - if ( mp->cur_type==mp_token_list ) mp_info(p)=mp->cur_exp; - else mp_info(p)=mp_stash_cur_exp(mp); - if ( mp->internal[mp_tracing_macros]>0 ) { - mp_begin_diagnostic(mp); mp_print_arg(mp, mp_info(p),n,mp_info(r)); - mp_end_diagnostic(mp, false); - } - if ( arg_list==null ) arg_list=p; - else mp_link(tail)=p; - tail=p; incr(n); -} - -@ @<Scan the argument represented by |mp_info(r)|@>= -if ( mp_info(r)>=text_base ) { - mp_scan_text_arg(mp, l_delim,r_delim); -} else { - mp_get_x_next(mp); - if ( mp_info(r)>=suffix_base ) mp_scan_suffix(mp); - else mp_scan_expression(mp); -} - -@ The parameters to |scan_text_arg| are either a pair of delimiters -or zero; the latter case is for undelimited text arguments, which -end with the first semicolon or \&{endgroup} or \&{end} that is not -contained in a group. - -@<Declarations@>= -static void mp_scan_text_arg (MP mp,pointer l_delim, pointer r_delim) ; - -@ @c -void mp_scan_text_arg (MP mp,pointer l_delim, pointer r_delim) { - integer balance; /* excess of |l_delim| over |r_delim| */ - pointer p; /* list tail */ - mp->warning_info=l_delim; mp->scanner_status=absorbing; - p=hold_head; balance=1; mp_link(hold_head)=null; - while (1) { - get_t_next; - if ( l_delim==0 ) { - @<Adjust the balance for an undelimited argument; |break| if done@>; - } else { - @<Adjust the balance for a delimited argument; |break| if done@>; - } - mp_link(p)=mp_cur_tok(mp); p=mp_link(p); - } - mp->cur_exp=mp_link(hold_head); mp->cur_type=mp_token_list; - mp->scanner_status=normal; -} - -@ @<Adjust the balance for a delimited argument...@>= -if ( mp->cur_cmd==right_delimiter ) { - if ( mp->cur_mod==l_delim ) { - decr(balance); - if ( balance==0 ) break; - } -} else if ( mp->cur_cmd==left_delimiter ) { - if ( mp->cur_mod==r_delim ) incr(balance); -} - -@ @<Adjust the balance for an undelimited...@>= -if ( end_of_statement ) { /* |cur_cmd=semicolon|, |end_group|, or |stop| */ - if ( balance==1 ) { break; } - else { if ( mp->cur_cmd==end_group ) decr(balance); } -} else if ( mp->cur_cmd==begin_group ) { - incr(balance); -} - -@ @<Scan undelimited argument(s)@>= -{ - if ( mp_info(r)<text_macro ) { - mp_get_x_next(mp); - if ( mp_info(r)!=suffix_macro ) { - if ( (mp->cur_cmd==equals)||(mp->cur_cmd==assignment) ) mp_get_x_next(mp); - } - } - switch (mp_info(r)) { - case primary_macro:mp_scan_primary(mp); break; - case secondary_macro:mp_scan_secondary(mp); break; - case tertiary_macro:mp_scan_tertiary(mp); break; - case expr_macro:mp_scan_expression(mp); break; - case of_macro: - @<Scan an expression followed by `\&{of} $\langle$primary$\rangle$'@>; - break; - case suffix_macro: - @<Scan a suffix with optional delimiters@>; - break; - case text_macro:mp_scan_text_arg(mp, 0,0); break; - } /* there are no other cases */ - mp_back_input(mp); - @<Append the current expression to |arg_list|@>; -} - -@ @<Scan an expression followed by `\&{of} $\langle$primary$\rangle$'@>= -{ - mp_scan_expression(mp); p=mp_get_avail(mp); mp_info(p)=mp_stash_cur_exp(mp); - if ( mp->internal[mp_tracing_macros]>0 ) { - mp_begin_diagnostic(mp); mp_print_arg(mp, mp_info(p),n,0); - mp_end_diagnostic(mp, false); - } - if ( arg_list==null ) arg_list=p; else mp_link(tail)=p; - tail=p;incr(n); - if ( mp->cur_cmd!=of_token ) { - mp_missing_err(mp, "of"); mp_print(mp, " for "); -@.Missing `of'@> - mp_print_macro_name(mp, arg_list,macro_name); - help1("I've got the first argument; will look now for the other."); - mp_back_error(mp); - } - mp_get_x_next(mp); mp_scan_primary(mp); -} - -@ @<Scan a suffix with optional delimiters@>= -{ - if ( mp->cur_cmd!=left_delimiter ) { - l_delim=null; - } else { - l_delim=mp->cur_sym; r_delim=mp->cur_mod; mp_get_x_next(mp); - }; - mp_scan_suffix(mp); - if ( l_delim!=null ) { - if ((mp->cur_cmd!=right_delimiter)||(mp->cur_mod!=l_delim) ) { - mp_missing_err(mp, str(text(r_delim))); -@.Missing `)'@> - help2("I've gotten to the end of the macro parameter list.", - "You might want to delete some tokens before continuing."); - mp_back_error(mp); - } - mp_get_x_next(mp); - } -} - -@ Before we put a new token list on the input stack, it is wise to clean off -all token lists that have recently been depleted. Then a user macro that ends -with a call to itself will not require unbounded stack space. - -@<Feed the arguments and replacement text to the scanner@>= -while ( token_state &&(loc==null) ) mp_end_token_list(mp); /* conserve stack space */ -if ( mp->param_ptr+n>mp->max_param_stack ) { - mp->max_param_stack=mp->param_ptr+n; - if ( mp->max_param_stack>mp->param_size ) - mp_overflow(mp, "parameter stack size",mp->param_size); -@:MetaPost capacity exceeded parameter stack size}{\quad parameter stack size@> -} -mp_begin_token_list(mp, def_ref,macro); name=macro_name; loc=r; -if ( n>0 ) { - p=arg_list; - do { - mp->param_stack[mp->param_ptr]=mp_info(p); incr(mp->param_ptr); p=mp_link(p); - } while (p!=null); - mp_flush_list(mp, arg_list); -} - -@ It's sometimes necessary to put a single argument onto |param_stack|. -The |stack_argument| subroutine does this. - -@c -static void mp_stack_argument (MP mp,pointer p) { - if ( mp->param_ptr==mp->max_param_stack ) { - incr(mp->max_param_stack); - if ( mp->max_param_stack>mp->param_size ) - mp_overflow(mp, "parameter stack size",mp->param_size); -@:MetaPost capacity exceeded parameter stack size}{\quad parameter stack size@> - } - mp->param_stack[mp->param_ptr]=p; incr(mp->param_ptr); -} - -@* \[33] Conditional processing. -Let's consider now the way \&{if} commands are handled. - -Conditions can be inside conditions, and this nesting has a stack -that is independent of other stacks. -Four global variables represent the top of the condition stack: -|cond_ptr| points to pushed-down entries, if~any; |cur_if| tells whether -we are processing \&{if} or \&{elseif}; |if_limit| specifies -the largest code of a |fi_or_else| command that is syntactically legal; -and |if_line| is the line number at which the current conditional began. - -If no conditions are currently in progress, the condition stack has the -special state |cond_ptr=null|, |if_limit=normal|, |cur_if=0|, |if_line=0|. -Otherwise |cond_ptr| points to a two-word node; the |type|, |name_type|, and -|link| fields of the first word contain |if_limit|, |cur_if|, and -|cond_ptr| at the next level, and the second word contains the -corresponding |if_line|. - -@d if_node_size 2 /* number of words in stack entry for conditionals */ -@d if_line_field(A) mp->mem[(A)+1].cint -@d if_code 1 /* code for \&{if} being evaluated */ -@d fi_code 2 /* code for \&{fi} */ -@d else_code 3 /* code for \&{else} */ -@d else_if_code 4 /* code for \&{elseif} */ - -@<Glob...@>= -pointer cond_ptr; /* top of the condition stack */ -integer if_limit; /* upper bound on |fi_or_else| codes */ -quarterword cur_if; /* type of conditional being worked on */ -integer if_line; /* line where that conditional began */ - -@ @<Set init...@>= -mp->cond_ptr=null; mp->if_limit=normal; mp->cur_if=0; mp->if_line=0; - -@ @<Put each...@>= -mp_primitive(mp, "if",if_test,if_code); -@:if_}{\&{if} primitive@> -mp_primitive(mp, "fi",fi_or_else,fi_code); mp->eqtb[frozen_fi]=mp->eqtb[mp->cur_sym]; -@:fi_}{\&{fi} primitive@> -mp_primitive(mp, "else",fi_or_else,else_code); -@:else_}{\&{else} primitive@> -mp_primitive(mp, "elseif",fi_or_else,else_if_code); -@:else_if_}{\&{elseif} primitive@> - -@ @<Cases of |print_cmd_mod|...@>= -case if_test: -case fi_or_else: - switch (m) { - case if_code:mp_print(mp, "if"); break; - case fi_code:mp_print(mp, "fi"); break; - case else_code:mp_print(mp, "else"); break; - default: mp_print(mp, "elseif"); break; - } - break; - -@ Here is a procedure that ignores text until coming to an \&{elseif}, -\&{else}, or \&{fi} at level zero of $\&{if}\ldots\&{fi}$ -nesting. After it has acted, |cur_mod| will indicate the token that -was found. - -\MP's smallest two command codes are |if_test| and |fi_or_else|; this -makes the skipping process a bit simpler. - -@c -void mp_pass_text (MP mp) { - integer l = 0; - mp->scanner_status=skipping; - mp->warning_info=mp_true_line(mp); - while (1) { - get_t_next; - if ( mp->cur_cmd<=fi_or_else ) { - if ( mp->cur_cmd<fi_or_else ) { - incr(l); - } else { - if ( l==0 ) break; - if ( mp->cur_mod==fi_code ) decr(l); - } - } else { - @<Decrease the string reference count, - if the current token is a string@>; - } - } - mp->scanner_status=normal; -} - -@ @<Decrease the string reference count...@>= -if ( mp->cur_cmd==string_token ) { delete_str_ref(mp->cur_mod); } - -@ When we begin to process a new \&{if}, we set |if_limit:=if_code|; then -if \&{elseif} or \&{else} or \&{fi} occurs before the current \&{if} -condition has been evaluated, a colon will be inserted. -A construction like `\.{if fi}' would otherwise get \MP\ confused. - -@<Push the condition stack@>= -{ p=mp_get_node(mp, if_node_size); mp_link(p)=mp->cond_ptr; mp_type(p)=mp->if_limit; - mp_name_type(p)=mp->cur_if; if_line_field(p)=mp->if_line; - mp->cond_ptr=p; mp->if_limit=if_code; mp->if_line=mp_true_line(mp); - mp->cur_if=if_code; -} - -@ @<Pop the condition stack@>= -{ p=mp->cond_ptr; mp->if_line=if_line_field(p); - mp->cur_if=mp_name_type(p); mp->if_limit=mp_type(p); mp->cond_ptr=mp_link(p); - mp_free_node(mp, p,if_node_size); -} - -@ Here's a procedure that changes the |if_limit| code corresponding to -a given value of |cond_ptr|. - -@c -static void mp_change_if_limit (MP mp,quarterword l, pointer p) { - pointer q; - if ( p==mp->cond_ptr ) { - mp->if_limit=l; /* that's the easy case */ - } else { - q=mp->cond_ptr; - while (1) { - if ( q==null ) mp_confusion(mp, "if"); -@:this can't happen if}{\quad if@> - if ( mp_link(q)==p ) { - mp_type(q)=l; return; - } - q=mp_link(q); - } - } -} - -@ The user is supposed to put colons into the proper parts of conditional -statements. Therefore, \MP\ has to check for their presence. - -@c -static void mp_check_colon (MP mp) { - if ( mp->cur_cmd!=colon ) { - mp_missing_err(mp, ":"); -@.Missing `:'@> - help2("There should've been a colon after the condition.", - "I shall pretend that one was there."); - mp_back_error(mp); - } -} - -@ A condition is started when the |get_x_next| procedure encounters -an |if_test| command; in that case |get_x_next| calls |conditional|, -which is a recursive procedure. -@^recursion@> - -@c -void mp_conditional (MP mp) { - pointer save_cond_ptr; /* |cond_ptr| corresponding to this conditional */ - int new_if_limit; /* future value of |if_limit| */ - pointer p; /* temporary register */ - @<Push the condition stack@>; - save_cond_ptr=mp->cond_ptr; -RESWITCH: - mp_get_boolean(mp); new_if_limit=else_if_code; - if ( mp->internal[mp_tracing_commands]>unity ) { - @<Display the boolean value of |cur_exp|@>; - } -FOUND: - mp_check_colon(mp); - if ( mp->cur_exp==true_code ) { - mp_change_if_limit(mp, new_if_limit,save_cond_ptr); - return; /* wait for \&{elseif}, \&{else}, or \&{fi} */ - }; - @<Skip to \&{elseif} or \&{else} or \&{fi}, then |goto done|@>; -DONE: - mp->cur_if=mp->cur_mod; mp->if_line=mp_true_line(mp); - if ( mp->cur_mod==fi_code ) { - @<Pop the condition stack@> - } else if ( mp->cur_mod==else_if_code ) { - goto RESWITCH; - } else { - mp->cur_exp=true_code; new_if_limit=fi_code; mp_get_x_next(mp); - goto FOUND; - } -} - -@ In a construction like `\&{if} \&{if} \&{true}: $0=1$: \\{foo} -\&{else}: \\{bar} \&{fi}', the first \&{else} -that we come to after learning that the \&{if} is false is not the -\&{else} we're looking for. Hence the following curious logic is needed. - -@<Skip to \&{elseif}...@>= -while (1) { - mp_pass_text(mp); - if ( mp->cond_ptr==save_cond_ptr ) goto DONE; - else if ( mp->cur_mod==fi_code ) @<Pop the condition stack@>; -} - - -@ @<Display the boolean value...@>= -{ mp_begin_diagnostic(mp); - if ( mp->cur_exp==true_code ) mp_print(mp, "{true}"); - else mp_print(mp, "{false}"); - mp_end_diagnostic(mp, false); -} - -@ The processing of conditionals is complete except for the following -code, which is actually part of |get_x_next|. It comes into play when -\&{elseif}, \&{else}, or \&{fi} is scanned. - -@<Terminate the current conditional and skip to \&{fi}@>= -if ( mp->cur_mod>mp->if_limit ) { - if ( mp->if_limit==if_code ) { /* condition not yet evaluated */ - mp_missing_err(mp, ":"); -@.Missing `:'@> - mp_back_input(mp); mp->cur_sym=frozen_colon; mp_ins_error(mp); - } else { - print_err("Extra "); mp_print_cmd_mod(mp, fi_or_else,mp->cur_mod); -@.Extra else@> -@.Extra elseif@> -@.Extra fi@> - help1("I'm ignoring this; it doesn't match any if."); - mp_error(mp); - } -} else { - while ( mp->cur_mod!=fi_code ) mp_pass_text(mp); /* skip to \&{fi} */ - @<Pop the condition stack@>; -} - -@* \[34] Iterations. -To bring our treatment of |get_x_next| to a close, we need to consider what -\MP\ does when it sees \&{for}, \&{forsuffixes}, and \&{forever}. - -There's a global variable |loop_ptr| that keeps track of the \&{for} loops -that are currently active. If |loop_ptr=null|, no loops are in progress; -otherwise |mp_info(loop_ptr)| points to the iterative text of the current -(innermost) loop, and |mp_link(loop_ptr)| points to the data for any other -loops that enclose the current one. - -A loop-control node also has two other fields, called |loop_type| and -|loop_list|, whose contents depend on the type of loop: - -\yskip\indent|loop_type(loop_ptr)=null| means that |loop_list(loop_ptr)| -points to a list of one-word nodes whose |info| fields point to the -remaining argument values of a suffix list and expression list. - -\yskip\indent|loop_type(loop_ptr)=mp_void| means that the current loop is -`\&{forever}'. - -\yskip\indent|loop_type(loop_ptr)=progression_flag| means that -|p=loop_list(loop_ptr)| points to a ``progression node'' and |value(p)|, -|step_size(p)|, and |final_value(p)| contain the data for an arithmetic -progression. - -\yskip\indent|loop_type(loop_ptr)=p>mp_void| means that |p| points to an edge -header and |loop_list(loop_ptr)| points into the graphical object list for -that edge header. - -\yskip\noindent In the case of a progression node, the first word is not used -because the link field of words in the dynamic memory area cannot be arbitrary. - -@d loop_list_loc(A) ((A)+1) /* where the |loop_list| field resides */ -@d loop_type(A) mp_info(loop_list_loc((A))) /* the type of \&{for} loop */ -@d loop_list(A) mp_link(loop_list_loc((A))) /* the remaining list elements */ -@d loop_node_size 2 /* the number of words in a loop control node */ -@d progression_node_size 4 /* the number of words in a progression node */ -@d step_size(A) mp->mem[(A)+2].sc /* the step size in an arithmetic progression */ -@d final_value(A) mp->mem[(A)+3].sc /* the final value in an arithmetic progression */ -@d progression_flag (null+2) - /* |loop_type| value when |loop_list| points to a progression node */ - -@<Glob...@>= -pointer loop_ptr; /* top of the loop-control-node stack */ - -@ @<Set init...@>= -mp->loop_ptr=null; - -@ If the expressions that define an arithmetic progression in -a \&{for} loop don't have known numeric values, the |bad_for| -subroutine screams at the user. - -@c -static void mp_bad_for (MP mp, const char * s) { - mp_disp_err(mp, null,"Improper "); /* show the bad expression above the message */ -@.Improper...replaced by 0@> - mp_print(mp, s); mp_print(mp, " has been replaced by 0"); - help4("When you say `for x=a step b until c',", - "the initial value `a' and the step size `b'", - "and the final value `c' must have known numeric values.", - "I'm zeroing this one. Proceed, with fingers crossed."); - mp_put_get_flush_error(mp, 0); -} - -@ Here's what \MP\ does when \&{for}, \&{forsuffixes}, or \&{forever} -has just been scanned. (This code requires slight familiarity with -expression-parsing routines that we have not yet discussed; but it seems -to belong in the present part of the program, even though the original author -didn't write it until later. The reader may wish to come back to it.) - -@c void mp_begin_iteration (MP mp) { - halfword m; /* |expr_base| (\&{for}) or |suffix_base| (\&{forsuffixes}) */ - halfword n; /* hash address of the current symbol */ - pointer s; /* the new loop-control node */ - pointer p; /* substitution list for |scan_toks| */ - pointer q; /* link manipulation register */ - pointer pp; /* a new progression node */ - m=mp->cur_mod; n=mp->cur_sym; s=mp_get_node(mp, loop_node_size); - if ( m==start_forever ){ - loop_type(s)=mp_void; p=null; mp_get_x_next(mp); - } else { - mp_get_symbol(mp); p=mp_get_node(mp, token_node_size); - mp_info(p)=mp->cur_sym; value(p)=m; - mp_get_x_next(mp); - if ( mp->cur_cmd==within_token ) { - @<Set up a picture iteration@>; - } else { - @<Check for the |"="| or |":="| in a loop header@>; - @<Scan the values to be used in the loop@>; - } - } - @<Check for the presence of a colon@>; - @<Scan the loop text and put it on the loop control stack@>; - mp_resume_iteration(mp); -} - -@ @<Check for the |"="| or |":="| in a loop header@>= -if ( (mp->cur_cmd!=equals)&&(mp->cur_cmd!=assignment) ) { - mp_missing_err(mp, "="); -@.Missing `='@> - help3("The next thing in this loop should have been `=' or `:='.", - "But don't worry; I'll pretend that an equals sign", - "was present, and I'll look for the values next."); - mp_back_error(mp); -} - -@ @<Check for the presence of a colon@>= -if ( mp->cur_cmd!=colon ) { - mp_missing_err(mp, ":"); -@.Missing `:'@> - help3("The next thing in this loop should have been a `:'.", - "So I'll pretend that a colon was present;", - "everything from here to `endfor' will be iterated."); - mp_back_error(mp); -} - -@ We append a special |frozen_repeat_loop| token in place of the -`\&{endfor}' at the end of the loop. This will come through \MP's scanner -at the proper time to cause the loop to be repeated. - -(If the user tries some shenanigan like `\&{for} $\ldots$ \&{let} \&{endfor}', -he will be foiled by the |get_symbol| routine, which keeps frozen -tokens unchanged. Furthermore the |frozen_repeat_loop| is an \&{outer} -token, so it won't be lost accidentally.) - -@ @<Scan the loop text...@>= -q=mp_get_avail(mp); mp_info(q)=frozen_repeat_loop; -mp->scanner_status=loop_defining; mp->warning_info=n; -mp_info(s)=mp_scan_toks(mp, iteration,p,q,0); mp->scanner_status=normal; -mp_link(s)=mp->loop_ptr; mp->loop_ptr=s - -@ @<Initialize table...@>= -eq_type(frozen_repeat_loop)=repeat_loop+outer_tag; -text(frozen_repeat_loop)=intern(" ENDFOR"); - -@ The loop text is inserted into \MP's scanning apparatus by the -|resume_iteration| routine. - -@c void mp_resume_iteration (MP mp) { - pointer p,q; /* link registers */ - p=loop_type(mp->loop_ptr); - if ( p==progression_flag ) { - p=loop_list(mp->loop_ptr); /* now |p| points to a progression node */ - mp->cur_exp=value(p); - if ( @<The arithmetic progression has ended@> ) { - mp_stop_iteration(mp); - return; - } - mp->cur_type=mp_known; q=mp_stash_cur_exp(mp); /* make |q| an \&{expr} argument */ - value(p)=mp->cur_exp+step_size(p); /* set |value(p)| for the next iteration */ - } else if ( p==null ) { - p=loop_list(mp->loop_ptr); - if ( p==null ) { - mp_stop_iteration(mp); - return; - } - loop_list(mp->loop_ptr)=mp_link(p); q=mp_info(p); free_avail(p); - } else if ( p==mp_void ) { - mp_begin_token_list(mp, mp_info(mp->loop_ptr),forever_text); return; - } else { - @<Make |q| a capsule containing the next picture component from - |loop_list(loop_ptr)| or |goto not_found|@>; - } - mp_begin_token_list(mp, mp_info(mp->loop_ptr),loop_text); - mp_stack_argument(mp, q); - if ( mp->internal[mp_tracing_commands]>unity ) { - @<Trace the start of a loop@>; - } - return; -NOT_FOUND: - mp_stop_iteration(mp); -} - -@ @<The arithmetic progression has ended@>= -((step_size(p)>0)&&(mp->cur_exp>final_value(p)))|| - ((step_size(p)<0)&&(mp->cur_exp<final_value(p))) - -@ @<Trace the start of a loop@>= -{ - mp_begin_diagnostic(mp); mp_print_nl(mp, "{loop value="); -@.loop value=n@> - if ( (q!=null)&&(mp_link(q)==mp_void) ) mp_print_exp(mp, q,1); - else mp_show_token_list(mp, q,null,50,0); - mp_print_char(mp, xord('}')); mp_end_diagnostic(mp, false); -} - -@ @<Make |q| a capsule containing the next picture component from...@>= -{ q=loop_list(mp->loop_ptr); - if ( q==null ) goto NOT_FOUND; - skip_component(q) goto NOT_FOUND; - mp->cur_exp=mp_copy_objects(mp, loop_list(mp->loop_ptr),q); - mp_init_bbox(mp, mp->cur_exp); - mp->cur_type=mp_picture_type; - loop_list(mp->loop_ptr)=q; - q=mp_stash_cur_exp(mp); -} - -@ A level of loop control disappears when |resume_iteration| has decided -not to resume, or when an \&{exitif} construction has removed the loop text -from the input stack. - -@c void mp_stop_iteration (MP mp) { - pointer p,q; /* the usual */ - p=loop_type(mp->loop_ptr); - if ( p==progression_flag ) { - mp_free_node(mp, loop_list(mp->loop_ptr),progression_node_size); - } else if ( p==null ){ - q=loop_list(mp->loop_ptr); - while ( q!=null ) { - p=mp_info(q); - if ( p!=null ) { - if ( mp_link(p)==mp_void ) { /* it's an \&{expr} parameter */ - mp_recycle_value(mp, p); mp_free_node(mp, p,value_node_size); - } else { - mp_flush_token_list(mp, p); /* it's a \&{suffix} or \&{text} parameter */ - } - } - p=q; q=mp_link(q); free_avail(p); - } - } else if ( p>progression_flag ) { - delete_edge_ref(p); - } - p=mp->loop_ptr; mp->loop_ptr=mp_link(p); mp_flush_token_list(mp, mp_info(p)); - mp_free_node(mp, p,loop_node_size); -} - -@ Now that we know all about loop control, we can finish up -the missing portion of |begin_iteration| and we'll be done. - -The following code is performed after the `\.=' has been scanned in -a \&{for} construction (if |m=expr_base|) or a \&{forsuffixes} construction -(if |m=suffix_base|). - -@<Scan the values to be used in the loop@>= -loop_type(s)=null; q=loop_list_loc(s); mp_link(q)=null; /* |mp_link(q)=loop_list(s)| */ -do { - mp_get_x_next(mp); - if ( m!=expr_base ) { - mp_scan_suffix(mp); - } else { - if ( mp->cur_cmd>=colon ) if ( mp->cur_cmd<=comma ) - goto CONTINUE; - mp_scan_expression(mp); - if ( mp->cur_cmd==step_token ) if ( q==loop_list_loc(s) ) { - @<Prepare for step-until construction and |break|@>; - } - mp->cur_exp=mp_stash_cur_exp(mp); - } - mp_link(q)=mp_get_avail(mp); q=mp_link(q); - mp_info(q)=mp->cur_exp; mp->cur_type=mp_vacuous; -CONTINUE: - ; -} while (mp->cur_cmd==comma) - -@ @<Prepare for step-until construction and |break|@>= -{ - if ( mp->cur_type!=mp_known ) mp_bad_for(mp, "initial value"); - pp=mp_get_node(mp, progression_node_size); value(pp)=mp->cur_exp; - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type!=mp_known ) mp_bad_for(mp, "step size"); - step_size(pp)=mp->cur_exp; - if ( mp->cur_cmd!=until_token ) { - mp_missing_err(mp, "until"); -@.Missing `until'@> - help2("I assume you meant to say `until' after `step'.", - "So I'll look for the final value and colon next."); - mp_back_error(mp); - } - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type!=mp_known ) mp_bad_for(mp, "final value"); - final_value(pp)=mp->cur_exp; loop_list(s)=pp; - loop_type(s)=progression_flag; - break; -} - -@ The last case is when we have just seen ``\&{within}'', and we need to -parse a picture expression and prepare to iterate over it. - -@<Set up a picture iteration@>= -{ mp_get_x_next(mp); - mp_scan_expression(mp); - @<Make sure the current expression is a known picture@>; - loop_type(s)=mp->cur_exp; mp->cur_type=mp_vacuous; - q=mp_link(dummy_loc(mp->cur_exp)); - if ( q!= null ) - if ( is_start_or_stop(q) ) - if ( mp_skip_1component(mp, q)==null ) q=mp_link(q); - loop_list(s)=q; -} - -@ @<Make sure the current expression is a known picture@>= -if ( mp->cur_type!=mp_picture_type ) { - mp_disp_err(mp, null,"Improper iteration spec has been replaced by nullpicture"); - help1("When you say `for x in p', p must be a known picture."); - mp_put_get_flush_error(mp, mp_get_node(mp, edge_header_size)); - mp_init_edges(mp, mp->cur_exp); mp->cur_type=mp_picture_type; -} - -@* \[35] File names. -It's time now to fret about file names. Besides the fact that different -operating systems treat files in different ways, we must cope with the -fact that completely different naming conventions are used by different -groups of people. The following programs show what is required for one -particular operating system; similar routines for other systems are not -difficult to devise. -@^system dependencies@> - -\MP\ assumes that a file name has three parts: the name proper; its -``extension''; and a ``file area'' where it is found in an external file -system. The extension of an input file is assumed to be -`\.{.mp}' unless otherwise specified; it is `\.{.log}' on the -transcript file that records each run of \MP; it is `\.{.tfm}' on the font -metric files that describe characters in any fonts created by \MP; it is -`\.{.ps}' or `.{\it nnn}' for some number {\it nnn} on the \ps\ output files; -and it is `\.{.mem}' on the mem files written by \.{INIMP} to initialize \MP. -The file area can be arbitrary on input files, but files are usually -output to the user's current area. If an input file cannot be -found on the specified area, \MP\ will look for it on a special system -area; this special area is intended for commonly used input files. - -Simple uses of \MP\ refer only to file names that have no explicit -extension or area. For example, a person usually says `\.{input} \.{cmr10}' -instead of `\.{input} \.{cmr10.new}'. Simple file -names are best, because they make the \MP\ source files portable; -whenever a file name consists entirely of letters and digits, it should be -treated in the same way by all implementations of \MP. However, users -need the ability to refer to other files in their environment, especially -when responding to error messages concerning unopenable files; therefore -we want to let them use the syntax that appears in their favorite -operating system. - -@ \MP\ uses the same conventions that have proved to be satisfactory for -\TeX\ and \MF. In order to isolate the system-dependent aspects of file names, -@^system dependencies@> -the system-independent parts of \MP\ are expressed in terms -of three system-dependent -procedures called |begin_name|, |more_name|, and |end_name|. In -essence, if the user-specified characters of the file name are $c_1\ldots c_n$, -the system-independent driver program does the operations -$$|begin_name|;\,|more_name|(c_1);\,\ldots\,;\,|more_name|(c_n); -\,|end_name|.$$ -These three procedures communicate with each other via global variables. -Afterwards the file name will appear in the string pool as three strings -called |cur_name|\penalty10000\hskip-.05em, -|cur_area|, and |cur_ext|; the latter two are null (i.e., -|""|), unless they were explicitly specified by the user. - -Actually the situation is slightly more complicated, because \MP\ needs -to know when the file name ends. The |more_name| routine is a function -(with side effects) that returns |true| on the calls |more_name|$(c_1)$, -\dots, |more_name|$(c_{n-1})$. The final call |more_name|$(c_n)$ -returns |false|; or, it returns |true| and $c_n$ is the last character -on the current input line. In other words, -|more_name| is supposed to return |true| unless it is sure that the -file name has been completely scanned; and |end_name| is supposed to be able -to finish the assembly of |cur_name|, |cur_area|, and |cur_ext| regardless of -whether $|more_name|(c_n)$ returned |true| or |false|. - -@<Glob...@>= -char * cur_name; /* name of file just scanned */ -char * cur_area; /* file area just scanned, or \.{""} */ -char * cur_ext; /* file extension just scanned, or \.{""} */ - -@ It is easier to maintain reference counts if we assign initial values. - -@<Set init...@>= -mp->cur_name=xstrdup(""); -mp->cur_area=xstrdup(""); -mp->cur_ext=xstrdup(""); - -@ @<Dealloc variables@>= -xfree(mp->cur_area); -xfree(mp->cur_name); -xfree(mp->cur_ext); - -@ The file names we shall deal with for illustrative purposes have the -following structure: If the name contains `\.>' or `\.:', the file area -consists of all characters up to and including the final such character; -otherwise the file area is null. If the remaining file name contains -`\..', the file extension consists of all such characters from the first -remaining `\..' to the end, otherwise the file extension is null. -@^system dependencies@> - -We can scan such file names easily by using two global variables that keep track -of the occurrences of area and extension delimiters. Note that these variables -cannot be of type |pool_pointer| because a string pool compaction could occur -while scanning a file name. - -@<Glob...@>= -integer area_delimiter; - /* most recent `\.>' or `\.:' relative to |str_start[str_ptr]| */ -integer ext_delimiter; /* the relevant `\..', if any */ -boolean quoted_filename; /* whether the filename is wrapped in " markers */ - -@ Here now is the first of the system-dependent routines for file name scanning. -@^system dependencies@> - -The file name length is limited to |file_name_size|. That is good, because -in the current configuration we cannot call |mp_do_compaction| while a name -is being scanned, |mp->area_delimiter| and |mp->ext_delimiter| are direct -offsets into |mp->str_pool|. I am not in a great hurry to fix this, because -calling |str_room()| just once is more efficient anyway. TODO. - -@<Declarations@>= -static void mp_begin_name (MP mp); -static boolean mp_more_name (MP mp, ASCII_code c); -static void mp_end_name (MP mp); - -@ @c -void mp_begin_name (MP mp) { - xfree(mp->cur_name); - xfree(mp->cur_area); - xfree(mp->cur_ext); - mp->area_delimiter=-1; - mp->ext_delimiter=-1; - mp->quoted_filename=false; - str_room(file_name_size); -} - -@ And here's the second. -@^system dependencies@> - -@d IS_DIR_SEP(c) (c=='/' || c=='\\') - -@c -boolean mp_more_name (MP mp, ASCII_code c) { - if (c=='"') { - mp->quoted_filename= ! mp->quoted_filename; - } else if ((c==' '|| c=='\t') && (mp->quoted_filename==false)) { - return false; - } else { - if (IS_DIR_SEP (c)) { - mp->area_delimiter=mp->pool_ptr; - mp->ext_delimiter=-1; - } else if ( c=='.' ) { - mp->ext_delimiter=mp->pool_ptr; - } - append_char(c); /* contribute |c| to the current string */ - } - return true; -} - -@ The third. -@^system dependencies@> - -@d copy_pool_segment(A,B,C) { - A = xmalloc(C+1,sizeof(char)); - strncpy(A,(char *)(mp->str_pool+B),C); - A[C] = 0;} - -@c -void mp_end_name (MP mp) { - pool_pointer s; /* length of area, name, and extension */ - unsigned int len; - /* "my/w.mp" */ - s = mp->str_start[mp->str_ptr]; - if ( mp->area_delimiter<0 ) { - mp->cur_area=xstrdup(""); - } else { - len = (unsigned)(mp->area_delimiter-s+1); - copy_pool_segment(mp->cur_area,s,len); - s += len; - } - if ( mp->ext_delimiter<0 ) { - mp->cur_ext=xstrdup(""); - len = (unsigned)(mp->pool_ptr-s); - } else { - copy_pool_segment(mp->cur_ext,mp->ext_delimiter,(size_t)(mp->pool_ptr-mp->ext_delimiter)); - len = (unsigned)(mp->ext_delimiter-s); - } - copy_pool_segment(mp->cur_name,s,len); - mp->pool_ptr=s; /* don't need this partial string */ -} - -@ Conversely, here is a routine that takes three strings and prints a file -name that might have produced them. (The routine is system dependent, because -some operating systems put the file area last instead of first.) -@^system dependencies@> - -@<Basic printing...@>= -static void mp_print_file_name (MP mp, char * n, char * a, char * e) { - boolean must_quote = false; - if (((a != NULL) && (strchr(a,' ') != NULL)) || - ((n != NULL) && (strchr(n,' ') != NULL)) || - ((e != NULL) && (strchr(e,' ') != NULL))) - must_quote = true; - if (must_quote) mp_print_char(mp, (ASCII_code)'"'); - mp_print(mp, a); mp_print(mp, n); mp_print(mp, e); - if (must_quote) mp_print_char(mp, (ASCII_code)'"'); -} - -@ Another system-dependent routine is needed to convert three internal -\MP\ strings -to the |name_of_file| value that is used to open files. The present code -allows both lowercase and uppercase letters in the file name. -@^system dependencies@> - -@d append_to_name(A) { c=xord((int)(A)); - if ( k<file_name_size ) { - mp->name_of_file[k]=(char)xchr(c); - incr(k); - } -} - -@ @c -void mp_pack_file_name (MP mp, const char *n, const char *a, const char *e) { - integer k; /* number of positions filled in |name_of_file| */ - ASCII_code c; /* character being packed */ - const char *j; /* a character index */ - k=0; - assert(n!=NULL); - if (a!=NULL) { - for (j=a;*j!='\0';j++) { append_to_name(*j); } - } - for (j=n;*j!='\0';j++) { append_to_name(*j); } - if (e!=NULL) { - for (j=e;*j!='\0';j++) { append_to_name(*j); } - } - mp->name_of_file[k]=0; - mp->name_length=k; -} - -@ @<Internal library declarations@>= -void mp_pack_file_name (MP mp, const char *n, const char *a, const char *e) ; - -@ @<Option variables@>= -char *mem_name; /* for commandline */ - -@ @<Find constant sizes@>= -mp->mem_name = xstrdup(opt->mem_name); -if (mp->mem_name) { - size_t l = strlen(mp->mem_name); - if (l>4) { - char *test = strstr(mp->mem_name,".mem"); - if (test == mp->mem_name+l-4) { - *test = 0; - } - } -} - - -@ @<Dealloc variables@>= -xfree(mp->mem_name); - -@ This part of the program becomes active when a ``virgin'' \MP\ is -trying to get going, just after the preliminary initialization, or -when the user is substituting another mem file by typing `\.\&' after -the initial `\.{**}' prompt. The buffer contains the first line of -input in |buffer[loc..(last-1)]|, where |loc<last| and |buffer[loc]<>""|. - -@<Declarations@>= -static boolean mp_open_mem_name (MP mp) ; -static boolean mp_open_mem_file (MP mp) ; - -@ @c -boolean mp_open_mem_name (MP mp) { - if (mp->mem_name!=NULL) { - size_t l = strlen(mp->mem_name); - char *s = xstrdup (mp->mem_name); - if (l>4) { - char *test = strstr(s,".mem"); - if (test == NULL || test != s+l-4) { - s = xrealloc (s, l+5, 1); - strcat (s, ".mem"); - } - } else { - s = xrealloc (s, l+5, 1); - strcat (s, ".mem"); - } - mp->mem_file = (mp->open_file)(mp,s, "r", mp_filetype_memfile); - xfree(s); - if ( mp->mem_file ) return true; - } - return false; -} -boolean mp_open_mem_file (MP mp) { - if (mp->mem_file != NULL) - return true; - if (mp_open_mem_name(mp)) - return true; - if (mp_xstrcmp(mp->mem_name, "plain")) { - wake_up_terminal; - wterm_ln("Sorry, I can\'t find that mem file; will try PLAIN."); -@.Sorry, I can't find...@> - update_terminal; - /* now pull out all the stops: try for the system \.{plain} file */ - xfree(mp->mem_name); - mp->mem_name = xstrdup("plain"); - if (mp_open_mem_name(mp)) - return true; - } - wake_up_terminal; - wterm_ln("I can\'t find the PLAIN mem file!\n"); -@.I can't find PLAIN...@> -@.plain@> - return false; -} - -@ Operating systems often make it possible to determine the exact name (and -possible version number) of a file that has been opened. The following routine, -which simply makes a \MP\ string from the value of |name_of_file|, should -ideally be changed to deduce the full name of file~|f|, which is the file -most recently opened, if it is possible to do this. -@^system dependencies@> - -@<Declarations@>= -#define mp_a_make_name_string(A,B) mp_make_name_string(A) -#define mp_b_make_name_string(A,B) mp_make_name_string(A) -#define mp_w_make_name_string(A,B) mp_make_name_string(A) - -@ @c -static str_number mp_make_name_string (MP mp) { - int k; /* index into |name_of_file| */ - str_room(mp->name_length); - for (k=0;k<mp->name_length;k++) { - append_char(xord((int)mp->name_of_file[k])); - } - return mp_make_string(mp); -} - -@ Now let's consider the ``driver'' -routines by which \MP\ deals with file names -in a system-independent manner. First comes a procedure that looks for a -file name in the input by taking the information from the input buffer. -(We can't use |get_next|, because the conversion to tokens would -destroy necessary information.) - -This procedure doesn't allow semicolons or percent signs to be part of -file names, because of other conventions of \MP. -{\sl The {\logos METAFONT\/}book} doesn't -use semicolons or percents immediately after file names, but some users -no doubt will find it natural to do so; therefore system-dependent -changes to allow such characters in file names should probably -be made with reluctance, and only when an entire file name that -includes special characters is ``quoted'' somehow. -@^system dependencies@> - -@c -static void mp_scan_file_name (MP mp) { - mp_begin_name(mp); - while ( mp->buffer[loc]==' ' ) incr(loc); - while (1) { - if ( (mp->buffer[loc]==';')||(mp->buffer[loc]=='%') ) break; - if ( ! mp_more_name(mp, mp->buffer[loc]) ) break; - incr(loc); - } - mp_end_name(mp); -} - -@ Here is another version that takes its input from a string. - -@<Declare subroutines for parsing file names@>= -void mp_str_scan_file (MP mp, str_number s) ; - -@ @c -void mp_str_scan_file (MP mp, str_number s) { - pool_pointer p,q; /* current position and stopping point */ - mp_begin_name(mp); - p=mp->str_start[s]; q=str_stop(s); - while ( p<q ){ - if ( ! mp_more_name(mp, mp->str_pool[p]) ) break; - incr(p); - } - mp_end_name(mp); -} - -@ And one that reads from a |char*|. - -@<Declare subroutines for parsing file names@>= -extern void mp_ptr_scan_file (MP mp, char *s); - -@ @c -void mp_ptr_scan_file (MP mp, char *s) { - char *p, *q; /* current position and stopping point */ - mp_begin_name(mp); - p=s; q=p+strlen(s); - while ( p<q ){ - if ( ! mp_more_name(mp, xord((int)(*p)))) break; - p++; - } - mp_end_name(mp); -} - - -@ The global variable |job_name| contains the file name that was first -\&{input} by the user. This name is extended by `\.{.log}' and `\.{ps}' and -`\.{.mem}' and `\.{.tfm}' in order to make the names of \MP's output files. - -@<Glob...@>= -boolean log_opened; /* has the transcript file been opened? */ -char *log_name; /* full name of the log file */ - -@ @<Option variables@>= -char *job_name; /* principal file name */ - -@ Initially |job_name=NULL|; it becomes nonzero as soon as the true name is known. -We have |job_name=NULL| if and only if the `\.{log}' file has not been opened, -except of course for a short time just after |job_name| has become nonzero. - -@<Allocate or ...@>= -mp->job_name=mp_xstrdup(mp, opt->job_name); -if (opt->noninteractive && opt->ini_version) { - if (mp->job_name == NULL) - mp->job_name=mp_xstrdup(mp,mp->mem_name); - if (mp->job_name != NULL) { - size_t l = strlen(mp->job_name); - if (l>4) { - char *test = strstr(mp->job_name,".mem"); - if (test == mp->job_name+l-4) - *test = 0; - } - } -} -mp->log_opened=false; - -@ @<Dealloc variables@>= -xfree(mp->job_name); - -@ Here is a routine that manufactures the output file names, assuming that -|job_name<>0|. It ignores and changes the current settings of |cur_area| -and |cur_ext|. - -@d pack_cur_name mp_pack_file_name(mp, mp->cur_name,mp->cur_area,mp->cur_ext) - -@<Internal library ...@>= -void mp_pack_job_name (MP mp, const char *s) ; - -@ @c -void mp_pack_job_name (MP mp, const char *s) { /* |s = ".log"|, |".mem"|, |".ps"|, or .\\{nnn} */ - xfree(mp->cur_name); mp->cur_name=xstrdup(mp->job_name); - xfree(mp->cur_area); mp->cur_area=xstrdup(""); - xfree(mp->cur_ext); mp->cur_ext=xstrdup(s); - pack_cur_name; -} - -@ If some trouble arises when \MP\ tries to open a file, the following -routine calls upon the user to supply another file name. Parameter~|s| -is used in the error message to identify the type of file; parameter~|e| -is the default extension if none is given. Upon exit from the routine, -variables |cur_name|, |cur_area|, |cur_ext|, and |name_of_file| are -ready for another attempt at file opening. - -@<Internal library ...@>= -void mp_prompt_file_name (MP mp, const char * s, const char * e) ; - -@ @c void mp_prompt_file_name (MP mp, const char * s, const char * e) { - size_t k; /* index into |buffer| */ - char * saved_cur_name; - if ( mp->interaction==mp_scroll_mode ) - wake_up_terminal; - if (strcmp(s,"input file name")==0) { - print_err("I can\'t find file `"); -@.I can't find file x@> - } else { - print_err("I can\'t write on file `"); -@.I can't write on file x@> - } - mp_print_file_name(mp, mp->cur_name,mp->cur_area,mp->cur_ext); - mp_print(mp, "'."); - if (strcmp(e,"")==0) - mp_show_context(mp); - mp_print_nl(mp, "Please type another "); mp_print(mp, s); -@.Please type...@> - if (mp->noninteractive || mp->interaction<mp_scroll_mode ) - mp_fatal_error(mp, "*** (job aborted, file error in nonstop mode)"); -@.job aborted, file error...@> - saved_cur_name = xstrdup(mp->cur_name); - clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>; - if (strcmp(mp->cur_ext,"")==0) - mp->cur_ext=xstrdup(e); - if (strlen(mp->cur_name)==0) { - mp->cur_name=saved_cur_name; - } else { - xfree(saved_cur_name); - } - pack_cur_name; -} - -@ @<Scan file name in the buffer@>= -{ - mp_begin_name(mp); k=mp->first; - while ( (mp->buffer[k]==' ')&&(k<mp->last) ) incr(k); - while (1) { - if ( k==mp->last ) break; - if ( ! mp_more_name(mp, mp->buffer[k]) ) break; - incr(k); - } - mp_end_name(mp); -} - -@ The |open_log_file| routine is used to open the transcript file and to help -it catch up to what has previously been printed on the terminal. - -@c void mp_open_log_file (MP mp) { - unsigned old_setting; /* previous |selector| setting */ - int k; /* index into |months| and |buffer| */ - int l; /* end of first input line */ - integer m; /* the current month */ - const char *months="JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC"; - /* abbreviations of month names */ - old_setting=mp->selector; - if ( mp->job_name==NULL ) { - mp->job_name=xstrdup("mpout"); - } - mp_pack_job_name(mp,".log"); - while ( ! mp_a_open_out(mp, &mp->log_file, mp_filetype_log) ) { - @<Try to get a different log file name@>; - } - mp->log_name=xstrdup(mp->name_of_file); - mp->selector=log_only; mp->log_opened=true; - @<Print the banner line, including the date and time@>; - mp->input_stack[mp->input_ptr]=mp->cur_input; - /* make sure bottom level is in memory */ - if (!mp->noninteractive) { - mp_print_nl(mp, "**"); -@.**@> - l=mp->input_stack[0].limit_field-1; /* last position of first line */ - for (k=0;k<=l;k++) mp_print_str(mp, mp->buffer[k]); - mp_print_ln(mp); /* now the transcript file contains the first line of input */ - } - mp->selector=old_setting+2; /* |log_only| or |term_and_log| */ -} - -@ @<Dealloc variables@>= -xfree(mp->log_name); - -@ Sometimes |open_log_file| is called at awkward moments when \MP\ is -unable to print error messages or even to |show_context|. -The |prompt_file_name| routine can result in a |fatal_error|, but the |error| -routine will not be invoked because |log_opened| will be false. - -The normal idea of |mp_batch_mode| is that nothing at all should be written -on the terminal. However, in the unusual case that -no log file could be opened, we make an exception and allow -an explanatory message to be seen. - -Incidentally, the program always refers to the log file as a `\.{transcript -file}', because some systems cannot use the extension `\.{.log}' for -this file. - -@<Try to get a different log file name@>= -{ - mp->selector=term_only; - mp_prompt_file_name(mp, "transcript file name",".log"); -} - -@ @<Print the banner...@>= -{ - wlog(mp->banner); - mp_print(mp, mp->mem_ident); mp_print(mp, " "); - mp_print_int(mp, mp_round_unscaled(mp, mp->internal[mp_day])); - mp_print_char(mp, xord(' ')); - m=mp_round_unscaled(mp, mp->internal[mp_month]); - for (k=3*m-3;k<3*m;k++) { wlog_chr((unsigned char)months[k]); } - mp_print_char(mp, xord(' ')); - mp_print_int(mp, mp_round_unscaled(mp, mp->internal[mp_year])); - mp_print_char(mp, xord(' ')); - m=mp_round_unscaled(mp, mp->internal[mp_time]); - mp_print_dd(mp, m / 60); mp_print_char(mp, xord(':')); mp_print_dd(mp, m % 60); -} - -@ The |try_extension| function tries to open an input file determined by -|cur_name|, |cur_area|, and the argument |ext|. It returns |false| if it -can't find the file in |cur_area| or the appropriate system area. - -@c -static boolean mp_try_extension (MP mp, const char *ext) { - mp_pack_file_name(mp, mp->cur_name,mp->cur_area, ext); - in_name=xstrdup(mp->cur_name); - in_area=xstrdup(mp->cur_area); - if ( mp_a_open_in(mp, &cur_file, mp_filetype_program) ) { - return true; - } else { - mp_pack_file_name(mp, mp->cur_name,NULL,ext); - return mp_a_open_in(mp, &cur_file, mp_filetype_program); - } -} - -@ Let's turn now to the procedure that is used to initiate file reading -when an `\.{input}' command is being processed. - -@c void mp_start_input (MP mp) { /* \MP\ will \.{input} something */ - char *fname = NULL; - @<Put the desired file name in |(cur_name,cur_ext,cur_area)|@>; - while (1) { - mp_begin_file_reading(mp); /* set up |cur_file| and new level of input */ - if ( strlen(mp->cur_ext)==0 ) { - if ( mp_try_extension(mp, ".mp") ) break; - else if ( mp_try_extension(mp, "") ) break; - else if ( mp_try_extension(mp, ".mf") ) break; - /* |else do_nothing; | */ - } else if ( mp_try_extension(mp, mp->cur_ext) ) { - break; - } - mp_end_file_reading(mp); /* remove the level that didn't work */ - mp_prompt_file_name(mp, "input file name",""); - } - name=mp_a_make_name_string(mp, cur_file); - fname = xstrdup(mp->name_of_file); - if ( mp->job_name==NULL ) { - mp->job_name=xstrdup(mp->cur_name); - mp_open_log_file(mp); - } /* |open_log_file| doesn't |show_context|, so |limit| - and |loc| needn't be set to meaningful values yet */ - if ( ((int)mp->term_offset+(int)strlen(fname)) > (mp->max_print_line-2)) mp_print_ln(mp); - else if ( (mp->term_offset>0)||(mp->file_offset>0) ) mp_print_char(mp, xord(' ')); - mp_print_char(mp, xord('(')); incr(mp->open_parens); mp_print(mp, fname); - xfree(fname); - update_terminal; - @<Flush |name| and replace it with |cur_name| if it won't be needed@>; - @<Read the first line of the new file@>; -} - -@ This code should be omitted if |a_make_name_string| returns something other -than just a copy of its argument and the full file name is needed for opening -\.{MPX} files or implementing the switch-to-editor option. -@^system dependencies@> - -@<Flush |name| and replace it with |cur_name| if it won't be needed@>= -mp_flush_string(mp, name); name=rts(mp->cur_name); xfree(mp->cur_name) - -@ If the file is empty, it is considered to contain a single blank line, -so there is no need to test the return value. - -@<Read the first line...@>= -{ - line=1; - (void)mp_input_ln(mp, cur_file ); - mp_firm_up_the_line(mp); - mp->buffer[limit]=xord('%'); mp->first=(size_t)(limit+1); loc=start; -} - -@ @<Put the desired file name in |(cur_name,cur_ext,cur_area)|@>= -while ( token_state &&(loc==null) ) mp_end_token_list(mp); -if ( token_state ) { - print_err("File names can't appear within macros"); -@.File names can't...@> - help3("Sorry...I've converted what follows to tokens,", - "possibly garbaging the name you gave.", - "Please delete the tokens and insert the name again."); - mp_error(mp); -} -if ( file_state ) { - mp_scan_file_name(mp); -} else { - xfree(mp->cur_name); mp->cur_name=xstrdup(""); - xfree(mp->cur_ext); mp->cur_ext =xstrdup(""); - xfree(mp->cur_area); mp->cur_area=xstrdup(""); -} - -@ The following simple routine starts reading the \.{MPX} file associated -with the current input file. - -@c void mp_start_mpx_input (MP mp) { - char *origname = NULL; /* a copy of nameoffile */ - mp_pack_file_name(mp, in_name, in_area, ".mpx"); - @<Try to make sure |name_of_file| refers to a valid \.{MPX} file and - |goto not_found| if there is a problem@>; - mp_begin_file_reading(mp); - if ( ! mp_a_open_in(mp, &cur_file, mp_filetype_program) ) { - mp_end_file_reading(mp); - goto NOT_FOUND; - } - name=mp_a_make_name_string(mp, cur_file); - mp->mpx_name[iindex]=name; add_str_ref(name); - @<Read the first line of the new file@>; - xfree(origname); - return; -NOT_FOUND: - @<Explain that the \.{MPX} file can't be read and |succumb|@>; - xfree(origname); -} - -@ This should ideally be changed to do whatever is necessary to create the -\.{MPX} file given by |name_of_file| if it does not exist or if it is out -of date. This requires invoking \.{MPtoTeX} on the |origname| and passing -the results through \TeX\ and \.{DVItoMP}. (It is possible to use a -completely different typesetting program if suitable postprocessor is -available to perform the function of \.{DVItoMP}.) -@^system dependencies@> - -@ @<Exported types@>= -typedef int (*mp_makempx_cmd)(MP mp, char *origname, char *mtxname); - -@ @<Option variables@>= -mp_makempx_cmd run_make_mpx; - -@ @<Allocate or initialize ...@>= -set_callback_option(run_make_mpx); - -@ @<Declarations@>= -static int mp_run_make_mpx (MP mp, char *origname, char *mtxname); - -@ The default does nothing. -@c -int mp_run_make_mpx (MP mp, char *origname, char *mtxname) { - (void)mp; - (void)origname; - (void)mtxname; - return false; -} - -@ @<Try to make sure |name_of_file| refers to a valid \.{MPX} file and - |goto not_found| if there is a problem@>= -origname = mp_xstrdup(mp,mp->name_of_file); -*(origname+strlen(origname)-1)=0; /* drop the x */ -if (!(mp->run_make_mpx)(mp, origname, mp->name_of_file)) - goto NOT_FOUND - -@ @<Explain that the \.{MPX} file can't be read and |succumb|@>= -if ( mp->interaction==mp_error_stop_mode ) wake_up_terminal; -mp_print_nl(mp, ">> "); -mp_print(mp, origname); -mp_print_nl(mp, ">> "); -mp_print(mp, mp->name_of_file); -mp_print_nl(mp, "! Unable to make mpx file"); -help4("The two files given above are one of your source files", - "and an auxiliary file I need to read to find out what your", - "btex..etex blocks mean. If you don't know why I had trouble,", - "try running it manually through MPtoTeX, TeX, and DVItoMP"); -succumb; - -@ The last file-opening commands are for files accessed via the \&{readfrom} -@:read_from_}{\&{readfrom} primitive@> -operator and the \&{write} command. Such files are stored in separate arrays. -@:write_}{\&{write} primitive@> - -@<Types in the outer block@>= -typedef unsigned int readf_index; /* |0..max_read_files| */ -typedef unsigned int write_index; /* |0..max_write_files| */ - -@ @<Glob...@>= -readf_index max_read_files; /* maximum number of simultaneously open \&{readfrom} files */ -void ** rd_file; /* \&{readfrom} files */ -char ** rd_fname; /* corresponding file name or 0 if file not open */ -readf_index read_files; /* number of valid entries in the above arrays */ -write_index max_write_files; /* maximum number of simultaneously open \&{write} */ -void ** wr_file; /* \&{write} files */ -char ** wr_fname; /* corresponding file name or 0 if file not open */ -write_index write_files; /* number of valid entries in the above arrays */ - -@ @<Allocate or initialize ...@>= -mp->max_read_files=8; -mp->rd_file = xmalloc((mp->max_read_files+1),sizeof(void *)); -mp->rd_fname = xmalloc((mp->max_read_files+1),sizeof(char *)); -memset(mp->rd_fname, 0, sizeof(char *)*(mp->max_read_files+1)); -mp->max_write_files=8; -mp->wr_file = xmalloc((mp->max_write_files+1),sizeof(void *)); -mp->wr_fname = xmalloc((mp->max_write_files+1),sizeof(char *)); -memset(mp->wr_fname, 0, sizeof(char *)*(mp->max_write_files+1)); - - -@ This routine starts reading the file named by string~|s| without setting -|loc|, |limit|, or |name|. It returns |false| if the file is empty or cannot -be opened. Otherwise it updates |rd_file[n]| and |rd_fname[n]|. - -@c -static boolean mp_start_read_input (MP mp,char *s, readf_index n) { - mp_ptr_scan_file(mp, s); - pack_cur_name; - mp_begin_file_reading(mp); - if ( ! mp_a_open_in(mp, &mp->rd_file[n], (int)(mp_filetype_text+n)) ) - goto NOT_FOUND; - if ( ! mp_input_ln(mp, mp->rd_file[n] ) ) { - (mp->close_file)(mp,mp->rd_file[n]); - goto NOT_FOUND; - } - mp->rd_fname[n]=xstrdup(s); - return true; -NOT_FOUND: - mp_end_file_reading(mp); - return false; -} - -@ Open |wr_file[n]| using file name~|s| and update |wr_fname[n]|. - -@<Declarations@>= -static void mp_open_write_file (MP mp, char *s, readf_index n) ; - -@ @c void mp_open_write_file (MP mp,char *s, readf_index n) { - mp_ptr_scan_file(mp, s); - pack_cur_name; - while ( ! mp_a_open_out(mp, &mp->wr_file[n], (int)(mp_filetype_text+n)) ) - mp_prompt_file_name(mp, "file name for write output",""); - mp->wr_fname[n]=xstrdup(s); -} - - -@* \[36] Introduction to the parsing routines. -We come now to the central nervous system that sparks many of \MP's activities. -By evaluating expressions, from their primary constituents to ever larger -subexpressions, \MP\ builds the structures that ultimately define complete -pictures or fonts of type. - -Four mutually recursive subroutines are involved in this process: We call them -$$\hbox{|scan_primary|, |scan_secondary|, |scan_tertiary|, -and |scan_expression|.}$$ -@^recursion@> -Each of them is parameterless and begins with the first token to be scanned -already represented in |cur_cmd|, |cur_mod|, and |cur_sym|. After execution, -the value of the primary or secondary or tertiary or expression that was -found will appear in the global variables |cur_type| and |cur_exp|. The -token following the expression will be represented in |cur_cmd|, |cur_mod|, -and |cur_sym|. - -Technically speaking, the parsing algorithms are ``LL(1),'' more or less; -backup mechanisms have been added in order to provide reasonable error -recovery. - -@<Glob...@>= -quarterword cur_type; /* the type of the expression just found */ -integer cur_exp; /* the value of the expression just found */ - -@ @<Set init...@>= -mp->cur_exp=0; - -@ Many different kinds of expressions are possible, so it is wise to have -precise descriptions of what |cur_type| and |cur_exp| mean in all cases: - -\smallskip\hang -|cur_type=mp_vacuous| means that this expression didn't turn out to have a -value at all, because it arose from a \&{begingroup}$\,\ldots\,$\&{endgroup} -construction in which there was no expression before the \&{endgroup}. -In this case |cur_exp| has some irrelevant value. - -\smallskip\hang -|cur_type=mp_boolean_type| means that |cur_exp| is either |true_code| -or |false_code|. - -\smallskip\hang -|cur_type=mp_unknown_boolean| means that |cur_exp| points to a capsule -node that is in -a ring of equivalent booleans whose value has not yet been defined. - -\smallskip\hang -|cur_type=mp_string_type| means that |cur_exp| is a string number (i.e., an -integer in the range |0<=cur_exp<str_ptr|). That string's reference count -includes this particular reference. - -\smallskip\hang -|cur_type=mp_unknown_string| means that |cur_exp| points to a capsule -node that is in -a ring of equivalent strings whose value has not yet been defined. - -\smallskip\hang -|cur_type=mp_pen_type| means that |cur_exp| points to a node in a pen. Nobody -else points to any of the nodes in this pen. The pen may be polygonal or -elliptical. - -\smallskip\hang -|cur_type=mp_unknown_pen| means that |cur_exp| points to a capsule -node that is in -a ring of equivalent pens whose value has not yet been defined. - -\smallskip\hang -|cur_type=mp_path_type| means that |cur_exp| points to a the first node of -a path; nobody else points to this particular path. The control points of -the path will have been chosen. - -\smallskip\hang -|cur_type=mp_unknown_path| means that |cur_exp| points to a capsule -node that is in -a ring of equivalent paths whose value has not yet been defined. - -\smallskip\hang -|cur_type=mp_picture_type| means that |cur_exp| points to an edge header node. -There may be other pointers to this particular set of edges. The header node -contains a reference count that includes this particular reference. - -\smallskip\hang -|cur_type=mp_unknown_picture| means that |cur_exp| points to a capsule -node that is in -a ring of equivalent pictures whose value has not yet been defined. - -\smallskip\hang -|cur_type=mp_transform_type| means that |cur_exp| points to a |mp_transform_type| -capsule node. The |value| part of this capsule -points to a transform node that contains six numeric values, -each of which is |independent|, |dependent|, |mp_proto_dependent|, or |known|. - -\smallskip\hang -|cur_type=mp_color_type| means that |cur_exp| points to a |color_type| -capsule node. The |value| part of this capsule -points to a color node that contains three numeric values, -each of which is |independent|, |dependent|, |mp_proto_dependent|, or |known|. - -\smallskip\hang -|cur_type=mp_cmykcolor_type| means that |cur_exp| points to a |mp_cmykcolor_type| -capsule node. The |value| part of this capsule -points to a color node that contains four numeric values, -each of which is |independent|, |dependent|, |mp_proto_dependent|, or |known|. - -\smallskip\hang -|cur_type=mp_pair_type| means that |cur_exp| points to a capsule -node whose type is |mp_pair_type|. The |value| part of this capsule -points to a pair node that contains two numeric values, -each of which is |independent|, |dependent|, |mp_proto_dependent|, or |known|. - -\smallskip\hang -|cur_type=mp_known| means that |cur_exp| is a |scaled| value. - -\smallskip\hang -|cur_type=mp_dependent| means that |cur_exp| points to a capsule node whose type -is |dependent|. The |dep_list| field in this capsule points to the associated -dependency list. - -\smallskip\hang -|cur_type=mp_proto_dependent| means that |cur_exp| points to a |mp_proto_dependent| -capsule node. The |dep_list| field in this capsule -points to the associated dependency list. - -\smallskip\hang -|cur_type=independent| means that |cur_exp| points to a capsule node -whose type is |independent|. This somewhat unusual case can arise, for -example, in the expression -`$x+\&{begingroup}\penalty0\,\&{string}\,x; 0\,\&{endgroup}$'. - -\smallskip\hang -|cur_type=mp_token_list| means that |cur_exp| points to a linked list of -tokens. - -\smallskip\noindent -The possible settings of |cur_type| have been listed here in increasing -numerical order. Notice that |cur_type| will never be |mp_numeric_type| or -|suffixed_macro| or |mp_unsuffixed_macro|, although variables of those types -are allowed. Conversely, \MP\ has no variables of type |mp_vacuous| or -|token_list|. - -@ Capsules are two-word nodes that have a similar meaning -to |cur_type| and |cur_exp|. Such nodes have |name_type=capsule|, -and their |type| field is one of the possibilities for |cur_type| listed above. -Also |link<=void| in capsules that aren't part of a token list. - -The |value| field of a capsule is, in most cases, the value that -corresponds to its |type|, as |cur_exp| corresponds to |cur_type|. -However, when |cur_exp| would point to a capsule, -no extra layer of indirection is present; the |value| -field is what would have been called |value(cur_exp)| if it had not been -encapsulated. Furthermore, if the type is |dependent| or -|mp_proto_dependent|, the |value| field of a capsule is replaced by -|dep_list| and |prev_dep| fields, since dependency lists in capsules are -always part of the general |dep_list| structure. - -The |get_x_next| routine is careful not to change the values of |cur_type| -and |cur_exp| when it gets an expanded token. However, |get_x_next| might -call a macro, which might parse an expression, which might execute lots of -commands in a group; hence it's possible that |cur_type| might change -from, say, |mp_unknown_boolean| to |mp_boolean_type|, or from |dependent| to -|known| or |independent|, during the time |get_x_next| is called. The -programs below are careful to stash sensitive intermediate results in -capsules, so that \MP's generality doesn't cause trouble. - -Here's a procedure that illustrates these conventions. It takes -the contents of $(|cur_type|\kern-.3pt,|cur_exp|\kern-.3pt)$ -and stashes them away in a -capsule. It is not used when |cur_type=mp_token_list|. -After the operation, |cur_type=mp_vacuous|; hence there is no need to -copy path lists or to update reference counts, etc. - -The special link |mp_void| is put on the capsule returned by -|stash_cur_exp|, because this procedure is used to store macro parameters -that must be easily distinguishable from token lists. - -@<Declare the stashing/unstashing routines@>= -static pointer mp_stash_cur_exp (MP mp) { - pointer p; /* the capsule that will be returned */ - switch (mp->cur_type) { - case unknown_types: - case mp_transform_type: - case mp_color_type: - case mp_pair_type: - case mp_dependent: - case mp_proto_dependent: - case mp_independent: - case mp_cmykcolor_type: - p=mp->cur_exp; - break; - default: - p=mp_get_node(mp, value_node_size); mp_name_type(p)=mp_capsule; - mp_type(p)=mp->cur_type; value(p)=mp->cur_exp; - break; - } - mp->cur_type=mp_vacuous; mp_link(p)=mp_void; - return p; -} - -@ The inverse of |stash_cur_exp| is the following procedure, which -deletes an unnecessary capsule and puts its contents into |cur_type| -and |cur_exp|. - -The program steps of \MP\ can be divided into two categories: those in -which |cur_type| and |cur_exp| are ``alive'' and those in which they are -``dead,'' in the sense that |cur_type| and |cur_exp| contain relevant -information or not. It's important not to ignore them when they're alive, -and it's important not to pay attention to them when they're dead. - -There's also an intermediate category: If |cur_type=mp_vacuous|, then -|cur_exp| is irrelevant, hence we can proceed without caring if |cur_type| -and |cur_exp| are alive or dead. In such cases we say that |cur_type| -and |cur_exp| are {\sl dormant}. It is permissible to call |get_x_next| -only when they are alive or dormant. - -The \\{stash} procedure above assumes that |cur_type| and |cur_exp| -are alive or dormant. The \\{unstash} procedure assumes that they are -dead or dormant; it resuscitates them. - -@<Declare the stashing/unstashing...@>= -static void mp_unstash_cur_exp (MP mp,pointer p) ; - -@ @c -void mp_unstash_cur_exp (MP mp,pointer p) { - mp->cur_type=mp_type(p); - switch (mp->cur_type) { - case unknown_types: - case mp_transform_type: - case mp_color_type: - case mp_pair_type: - case mp_dependent: - case mp_proto_dependent: - case mp_independent: - case mp_cmykcolor_type: - mp->cur_exp=p; - break; - default: - mp->cur_exp=value(p); - mp_free_node(mp, p,value_node_size); - break; - } -} - -@ The following procedure prints the values of expressions in an -abbreviated format. If its first parameter |p| is null, the value of -|(cur_type,cur_exp)| is displayed; otherwise |p| should be a capsule -containing the desired value. The second parameter controls the amount of -output. If it is~0, dependency lists will be abbreviated to -`\.{linearform}' unless they consist of a single term. If it is greater -than~1, complicated structures (pens, pictures, and paths) will be displayed -in full. -@.linearform@> - -@<Declarations@>= -@<Declare the procedure called |print_dp|@> -@<Declare the stashing/unstashing routines@> -static void mp_print_exp (MP mp,pointer p, quarterword verbosity) ; - -@ @c -void mp_print_exp (MP mp,pointer p, quarterword verbosity) { - boolean restore_cur_exp; /* should |cur_exp| be restored? */ - quarterword t; /* the type of the expression */ - pointer q; /* a big node being displayed */ - integer v=0; /* the value of the expression */ - if ( p!=null ) { - restore_cur_exp=false; - } else { - p=mp_stash_cur_exp(mp); restore_cur_exp=true; - } - t=mp_type(p); - if ( t<mp_dependent ) v=value(p); else if ( t<mp_independent ) v=dep_list(p); - @<Print an abbreviated value of |v| with format depending on |t|@>; - if ( restore_cur_exp ) mp_unstash_cur_exp(mp, p); -} - -@ @<Print an abbreviated value of |v| with format depending on |t|@>= -switch (t) { -case mp_vacuous:mp_print(mp, "mp_vacuous"); break; -case mp_boolean_type: - if ( v==true_code ) mp_print(mp, "true"); else mp_print(mp, "false"); - break; -case unknown_types: case mp_numeric_type: - @<Display a variable that's been declared but not defined@>; - break; -case mp_string_type: - mp_print_char(mp, xord('"')); mp_print_str(mp, v); mp_print_char(mp, xord('"')); - break; -case mp_pen_type: case mp_path_type: case mp_picture_type: - @<Display a complex type@>; - break; -case mp_transform_type: case mp_color_type: case mp_pair_type: case mp_cmykcolor_type: - if ( v==null ) mp_print_type(mp, t); - else @<Display a big node@>; - break; -case mp_known:mp_print_scaled(mp, v); break; -case mp_dependent: case mp_proto_dependent: - mp_print_dp(mp, t,v,verbosity); - break; -case mp_independent:mp_print_variable_name(mp, p); break; -default: mp_confusion(mp, "exp"); break; -@:this can't happen exp}{\quad exp@> -} - -@ @<Display a big node@>= -{ - mp_print_char(mp, xord('(')); q=v+mp->big_node_size[t]; - do { - if ( mp_type(v)==mp_known ) mp_print_scaled(mp, value(v)); - else if ( mp_type(v)==mp_independent ) mp_print_variable_name(mp, v); - else mp_print_dp(mp, mp_type(v),dep_list(v),verbosity); - v=v+2; - if ( v!=q ) mp_print_char(mp, xord(',')); - } while (v!=q); - mp_print_char(mp, xord(')')); -} - -@ Values of type \&{picture}, \&{path}, and \&{pen} are displayed verbosely -in the log file only, unless the user has given a positive value to -\\{tracingonline}. - -@<Display a complex type@>= -if ( verbosity<=1 ) { - mp_print_type(mp, t); -} else { - if ( mp->selector==term_and_log ) - if ( mp->internal[mp_tracing_online]<=0 ) { - mp->selector=term_only; - mp_print_type(mp, t); mp_print(mp, " (see the transcript file)"); - mp->selector=term_and_log; - }; - switch (t) { - case mp_pen_type:mp_print_pen(mp, v,"",false); break; - case mp_path_type:mp_print_path(mp, v,"",false); break; - case mp_picture_type:mp_print_edges(mp, v,"",false); break; - } /* there are no other cases */ -} - -@ @<Declare the procedure called |print_dp|@>= -static void mp_print_dp (MP mp, quarterword t, pointer p, - quarterword verbosity) { - pointer q; /* the node following |p| */ - q=mp_link(p); - if ( (mp_info(q)==null) || (verbosity>0) ) mp_print_dependency(mp, p,t); - else mp_print(mp, "linearform"); -} - -@ The displayed name of a variable in a ring will not be a capsule unless -the ring consists entirely of capsules. - -@<Display a variable that's been declared but not defined@>= -{ mp_print_type(mp, t); -if ( v!=null ) - { mp_print_char(mp, xord(' ')); - while ( (mp_name_type(v)==mp_capsule) && (v!=p) ) v=value(v); - mp_print_variable_name(mp, v); - }; -} - -@ When errors are detected during parsing, it is often helpful to -display an expression just above the error message, using |exp_err| -or |disp_err| instead of |print_err|. - -@d exp_err(A) mp_disp_err(mp, null,(A)) /* displays the current expression */ - -@<Declarations@>= -static void mp_disp_err (MP mp,pointer p, const char *s) ; - -@ @c -void mp_disp_err (MP mp,pointer p, const char *s) { - if ( mp->interaction==mp_error_stop_mode ) wake_up_terminal; - mp_print_nl(mp, ">> "); -@.>>@> - mp_print_exp(mp, p,1); /* ``medium verbose'' printing of the expression */ - if (strlen(s)>0) { - print_err(s); - } -} - -@ If |cur_type| and |cur_exp| contain relevant information that should -be recycled, we will use the following procedure, which changes |cur_type| -to |known| and stores a given value in |cur_exp|. We can think of |cur_type| -and |cur_exp| as either alive or dormant after this has been done, -because |cur_exp| will not contain a pointer value. - -@ @c -static void mp_flush_cur_exp (MP mp,scaled v) { - switch (mp->cur_type) { - case unknown_types: case mp_transform_type: case mp_color_type: case mp_pair_type: - case mp_dependent: case mp_proto_dependent: case mp_independent: case mp_cmykcolor_type: - mp_recycle_value(mp, mp->cur_exp); - mp_free_node(mp, mp->cur_exp,value_node_size); - break; - case mp_string_type: - delete_str_ref(mp->cur_exp); break; - case mp_pen_type: case mp_path_type: - mp_toss_knot_list(mp, mp->cur_exp); break; - case mp_picture_type: - delete_edge_ref(mp->cur_exp); break; - default: - break; - } - mp->cur_type=mp_known; mp->cur_exp=v; -} - -@ There's a much more general procedure that is capable of releasing -the storage associated with any two-word value packet. - -@<Declarations@>= -static void mp_recycle_value (MP mp,pointer p) ; - -@ @c -static void mp_recycle_value (MP mp,pointer p) { - quarterword t; /* a type code */ - integer vv; /* another value */ - pointer q,r,s,pp; /* link manipulation registers */ - integer v=0; /* a value */ - t=mp_type(p); - if ( t<mp_dependent ) v=value(p); - switch (t) { - case undefined: case mp_vacuous: case mp_boolean_type: case mp_known: - case mp_numeric_type: - break; - case unknown_types: - mp_ring_delete(mp, p); break; - case mp_string_type: - delete_str_ref(v); break; - case mp_path_type: case mp_pen_type: - mp_toss_knot_list(mp, v); break; - case mp_picture_type: - delete_edge_ref(v); break; - case mp_cmykcolor_type: case mp_pair_type: case mp_color_type: - case mp_transform_type: - @<Recycle a big node@>; break; - case mp_dependent: case mp_proto_dependent: - @<Recycle a dependency list@>; break; - case mp_independent: - @<Recycle an independent variable@>; break; - case mp_token_list: case mp_structured: - mp_confusion(mp, "recycle"); break; -@:this can't happen recycle}{\quad recycle@> - case mp_unsuffixed_macro: case mp_suffixed_macro: - mp_delete_mac_ref(mp, value(p)); break; - } /* there are no other cases */ - mp_type(p)=undefined; -} - -@ @<Recycle a big node@>= -if ( v!=null ){ - q=v+mp->big_node_size[t]; - do { - q=q-2; mp_recycle_value(mp, q); - } while (q!=v); - mp_free_node(mp, v,mp->big_node_size[t]); -} - -@ @<Recycle a dependency list@>= -{ - q=dep_list(p); - while ( mp_info(q)!=null ) q=mp_link(q); - mp_link(prev_dep(p))=mp_link(q); - prev_dep(mp_link(q))=prev_dep(p); - mp_link(q)=null; mp_flush_node_list(mp, dep_list(p)); -} - -@ When an independent variable disappears, it simply fades away, unless -something depends on it. In the latter case, a dependent variable whose -coefficient of dependence is maximal will take its place. -The relevant algorithm is due to Ignacio~A. Zabala, who implemented it -as part of his Ph.D. thesis (Stanford University, December 1982). -@^Zabala Salelles, Ignacio Andr\'es@> - -For example, suppose that variable $x$ is being recycled, and that the -only variables depending on~$x$ are $y=2x+a$ and $z=x+b$. In this case -we want to make $y$ independent and $z=.5y-.5a+b$; no other variables -will depend on~$y$. If $\\{tracingequations}>0$ in this situation, -we will print `\.{\#\#\# -2x=-y+a}'. - -There's a slight complication, however: An independent variable $x$ -can occur both in dependency lists and in proto-dependency lists. -This makes it necessary to be careful when deciding which coefficient -is maximal. - -Furthermore, this complication is not so slight when -a proto-dependent variable is chosen to become independent. For example, -suppose that $y=2x+100a$ is proto-dependent while $z=x+b$ is dependent; -then we must change $z=.5y-50a+b$ to a proto-dependency, because of the -large coefficient `50'. - -In order to deal with these complications without wasting too much time, -we shall link together the occurrences of~$x$ among all the linear -dependencies, maintaining separate lists for the dependent and -proto-dependent cases. - -@<Recycle an independent variable@>= -{ - mp->max_c[mp_dependent]=0; mp->max_c[mp_proto_dependent]=0; - mp->max_link[mp_dependent]=null; mp->max_link[mp_proto_dependent]=null; - q=mp_link(dep_head); - while ( q!=dep_head ) { - s=value_loc(q); /* now |mp_link(s)=dep_list(q)| */ - while (1) { - r=mp_link(s); - if ( mp_info(r)==null ) break; - if ( mp_info(r)!=p ) { - s=r; - } else { - t=mp_type(q); mp_link(s)=mp_link(r); mp_info(r)=q; - if ( abs(value(r))>mp->max_c[t] ) { - @<Record a new maximum coefficient of type |t|@>; - } else { - mp_link(r)=mp->max_link[t]; mp->max_link[t]=r; - } - } - } - q=mp_link(r); - } - if ( (mp->max_c[mp_dependent]>0)||(mp->max_c[mp_proto_dependent]>0) ) { - @<Choose a dependent variable to take the place of the disappearing - independent variable, and change all remaining dependencies - accordingly@>; - } -} - -@ The code for independency removal makes use of three two-word arrays. - -@<Glob...@>= -integer max_c[mp_proto_dependent+1]; /* max coefficient magnitude */ -pointer max_ptr[mp_proto_dependent+1]; /* where |p| occurs with |max_c| */ -pointer max_link[mp_proto_dependent+1]; /* other occurrences of |p| */ - -@ @<Record a new maximum coefficient...@>= -{ - if ( mp->max_c[t]>0 ) { - mp_link(mp->max_ptr[t])=mp->max_link[t]; mp->max_link[t]=mp->max_ptr[t]; - } - mp->max_c[t]=abs(value(r)); mp->max_ptr[t]=r; -} - -@ @<Choose a dependent...@>= -{ - if ( (mp->max_c[mp_dependent] / 010000) >= mp->max_c[mp_proto_dependent] ) - t=mp_dependent; - else - t=mp_proto_dependent; - @<Determine the dependency list |s| to substitute for the independent - variable~|p|@>; - t=mp_dependent+mp_proto_dependent-t; /* complement |t| */ - if ( mp->max_c[t]>0 ) { /* we need to pick up an unchosen dependency */ - mp_link(mp->max_ptr[t])=mp->max_link[t]; mp->max_link[t]=mp->max_ptr[t]; - } - if ( t!=mp_dependent ) { @<Substitute new dependencies in place of |p|@>; } - else { @<Substitute new proto-dependencies in place of |p|@>;} - mp_flush_node_list(mp, s); - if ( mp->fix_needed ) mp_fix_dependencies(mp); - check_arith; -} - -@ Let |s=max_ptr[t]|. At this point we have $|value|(s)=\pm|max_c|[t]$, -and |mp_info(s)| points to the dependent variable~|pp| of type~|t| from -whose dependency list we have removed node~|s|. We must reinsert -node~|s| into the dependency list, with coefficient $-1.0$, and with -|pp| as the new independent variable. Since |pp| will have a larger serial -number than any other variable, we can put node |s| at the head of the -list. - -@<Determine the dep...@>= -s=mp->max_ptr[t]; pp=mp_info(s); v=value(s); -if ( t==mp_dependent ) value(s)=-fraction_one; else value(s)=-unity; -r=dep_list(pp); mp_link(s)=r; -while ( mp_info(r)!=null ) r=mp_link(r); -q=mp_link(r); mp_link(r)=null; -prev_dep(q)=prev_dep(pp); mp_link(prev_dep(pp))=q; -new_indep(pp); -if ( mp->cur_exp==pp ) if ( mp->cur_type==t ) mp->cur_type=mp_independent; -if ( mp->internal[mp_tracing_equations]>0 ) { - @<Show the transformed dependency@>; -} - -@ Now $(-v)$ times the formerly independent variable~|p| is being replaced -by the dependency list~|s|. - -@<Show the transformed...@>= -if ( mp_interesting(mp, p) ) { - mp_begin_diagnostic(mp); mp_print_nl(mp, "### "); -@:]]]\#\#\#_}{\.{\#\#\#}@> - if ( v>0 ) mp_print_char(mp, xord('-')); - if ( t==mp_dependent ) vv=mp_round_fraction(mp, mp->max_c[mp_dependent]); - else vv=mp->max_c[mp_proto_dependent]; - if ( vv!=unity ) mp_print_scaled(mp, vv); - mp_print_variable_name(mp, p); - while ( value(p) % s_scale>0 ) { - mp_print(mp, "*4"); value(p)=value(p)-2; - } - if ( t==mp_dependent ) mp_print_char(mp, xord('=')); else mp_print(mp, " = "); - mp_print_dependency(mp, s,t); - mp_end_diagnostic(mp, false); -} - -@ Finally, there are dependent and proto-dependent variables whose -dependency lists must be brought up to date. - -@<Substitute new dependencies...@>= -for (t=mp_dependent;t<=mp_proto_dependent;t++){ - r=mp->max_link[t]; - while ( r!=null ) { - q=mp_info(r); - dep_list(q)=mp_p_plus_fq(mp, dep_list(q), - mp_make_fraction(mp, value(r),-v),s,t,mp_dependent); - if ( dep_list(q)==mp->dep_final ) mp_make_known(mp, q,mp->dep_final); - q=r; r=mp_link(r); mp_free_node(mp, q,dep_node_size); - } -} - -@ @<Substitute new proto...@>= -for (t=mp_dependent;t<=mp_proto_dependent;t++) { - r=mp->max_link[t]; - while ( r!=null ) { - q=mp_info(r); - if ( t==mp_dependent ) { /* for safety's sake, we change |q| to |mp_proto_dependent| */ - if ( mp->cur_exp==q ) if ( mp->cur_type==mp_dependent ) - mp->cur_type=mp_proto_dependent; - dep_list(q)=mp_p_over_v(mp, dep_list(q),unity, - mp_dependent,mp_proto_dependent); - mp_type(q)=mp_proto_dependent; - value(r)=mp_round_fraction(mp, value(r)); - } - dep_list(q)=mp_p_plus_fq(mp, dep_list(q), - mp_make_scaled(mp, value(r),-v),s, - mp_proto_dependent,mp_proto_dependent); - if ( dep_list(q)==mp->dep_final ) - mp_make_known(mp, q,mp->dep_final); - q=r; r=mp_link(r); mp_free_node(mp, q,dep_node_size); - } -} - -@ Here are some routines that provide handy combinations of actions -that are often needed during error recovery. For example, -`|flush_error|' flushes the current expression, replaces it by -a given value, and calls |error|. - -Errors often are detected after an extra token has already been scanned. -The `\\{put\_get}' routines put that token back before calling |error|; -then they get it back again. (Or perhaps they get another token, if -the user has changed things.) - -@<Declarations@>= -static void mp_flush_error (MP mp,scaled v); -static void mp_put_get_error (MP mp); -static void mp_put_get_flush_error (MP mp,scaled v) ; - -@ @c -void mp_flush_error (MP mp,scaled v) { - mp_error(mp); mp_flush_cur_exp(mp, v); -} -void mp_put_get_error (MP mp) { - mp_back_error(mp); mp_get_x_next(mp); -} -void mp_put_get_flush_error (MP mp,scaled v) { - mp_put_get_error(mp); - mp_flush_cur_exp(mp, v); -} - -@ A global variable |var_flag| is set to a special command code -just before \MP\ calls |scan_expression|, if the expression should be -treated as a variable when this command code immediately follows. For -example, |var_flag| is set to |assignment| at the beginning of a -statement, because we want to know the {\sl location\/} of a variable at -the left of `\.{:=}', not the {\sl value\/} of that variable. - -The |scan_expression| subroutine calls |scan_tertiary|, -which calls |scan_secondary|, which calls |scan_primary|, which sets -|var_flag:=0|. In this way each of the scanning routines ``knows'' -when it has been called with a special |var_flag|, but |var_flag| is -usually zero. - -A variable preceding a command that equals |var_flag| is converted to a -token list rather than a value. Furthermore, an `\.{=}' sign following an -expression with |var_flag=assignment| is not considered to be a relation -that produces boolean expressions. - - -@<Glob...@>= -int var_flag; /* command that wants a variable */ - -@ @<Set init...@>= -mp->var_flag=0; - -@* \[37] Parsing primary expressions. -The first parsing routine, |scan_primary|, is also the most complicated one, -since it involves so many different cases. But each case---with one -exception---is fairly simple by itself. - -When |scan_primary| begins, the first token of the primary to be scanned -should already appear in |cur_cmd|, |cur_mod|, and |cur_sym|. The values -of |cur_type| and |cur_exp| should be either dead or dormant, as explained -earlier. If |cur_cmd| is not between |min_primary_command| and -|max_primary_command|, inclusive, a syntax error will be signaled. - -@<Declare the basic parsing subroutines@>= -void mp_scan_primary (MP mp) { - pointer p,q,r; /* for list manipulation */ - quarterword c; /* a primitive operation code */ - int my_var_flag; /* initial value of |my_var_flag| */ - pointer l_delim,r_delim; /* hash addresses of a delimiter pair */ - @<Other local variables for |scan_primary|@>; - my_var_flag=mp->var_flag; mp->var_flag=0; -RESTART: - check_arith; - @<Supply diagnostic information, if requested@>; - switch (mp->cur_cmd) { - case left_delimiter: - @<Scan a delimited primary@>; break; - case begin_group: - @<Scan a grouped primary@>; break; - case string_token: - @<Scan a string constant@>; break; - case numeric_token: - @<Scan a primary that starts with a numeric token@>; break; - case nullary: - @<Scan a nullary operation@>; break; - case unary: case type_name: case cycle: case plus_or_minus: - @<Scan a unary operation@>; break; - case primary_binary: - @<Scan a binary operation with `\&{of}' between its operands@>; break; - case str_op: - @<Convert a suffix to a string@>; break; - case internal_quantity: - @<Scan an internal numeric quantity@>; break; - case capsule_token: - mp_make_exp_copy(mp, mp->cur_mod); break; - case tag_token: - @<Scan a variable primary; |goto restart| if it turns out to be a macro@>; break; - default: - mp_bad_exp(mp, "A primary"); goto RESTART; break; -@.A primary expression...@> - } - mp_get_x_next(mp); /* the routines |goto done| if they don't want this */ -DONE: - if ( mp->cur_cmd==left_bracket ) { - if ( mp->cur_type>=mp_known ) { - @<Scan a mediation construction@>; - } - } -} - - - -@ Errors at the beginning of expressions are flagged by |bad_exp|. - -@c -static void mp_bad_exp (MP mp, const char * s) { - int save_flag; - print_err(s); mp_print(mp, " expression can't begin with `"); - mp_print_cmd_mod(mp, mp->cur_cmd,mp->cur_mod); - mp_print_char(mp, xord('\'')); - help4("I'm afraid I need some sort of value in order to continue,", - "so I've tentatively inserted `0'. You may want to", - "delete this zero and insert something else;", - "see Chapter 27 of The METAFONTbook for an example."); -@:METAFONTbook}{\sl The {\logos METAFONT\/}book@> - mp_back_input(mp); mp->cur_sym=0; mp->cur_cmd=numeric_token; - mp->cur_mod=0; mp_ins_error(mp); - save_flag=mp->var_flag; mp->var_flag=0; mp_get_x_next(mp); - mp->var_flag=save_flag; -} - -@ @<Supply diagnostic information, if requested@>= -#ifdef DEBUG -if ( mp->panicking ) mp_check_mem(mp, false); -#endif -if ( mp->interrupt!=0 ) if ( mp->OK_to_interrupt ) { - mp_back_input(mp); check_interrupt; mp_get_x_next(mp); -} - -@ @<Scan a delimited primary@>= -{ - l_delim=mp->cur_sym; r_delim=mp->cur_mod; - mp_get_x_next(mp); mp_scan_expression(mp); - if ( (mp->cur_cmd==comma) && (mp->cur_type>=mp_known) ) { - @<Scan the rest of a delimited set of numerics@>; - } else { - mp_check_delimiter(mp, l_delim,r_delim); - } -} - -@ The |stash_in| subroutine puts the current (numeric) expression into a field -within a ``big node.'' - -@c -static void mp_stash_in (MP mp,pointer p) { - pointer q; /* temporary register */ - mp_type(p)=mp->cur_type; - if ( mp->cur_type==mp_known ) { - value(p)=mp->cur_exp; - } else { - if ( mp->cur_type==mp_independent ) { - @<Stash an independent |cur_exp| into a big node@>; - } else { - mp->mem[value_loc(p)]=mp->mem[value_loc(mp->cur_exp)]; - /* |dep_list(p):=dep_list(cur_exp)| and |prev_dep(p):=prev_dep(cur_exp)| */ - mp_link(prev_dep(p))=p; - } - mp_free_node(mp, mp->cur_exp,value_node_size); - } - mp->cur_type=mp_vacuous; -} - -@ In rare cases the current expression can become |independent|. There -may be many dependency lists pointing to such an independent capsule, -so we can't simply move it into place within a big node. Instead, -we copy it, then recycle it. - -@ @<Stash an independent |cur_exp|...@>= -{ - q=mp_single_dependency(mp, mp->cur_exp); - if ( q==mp->dep_final ){ - mp_type(p)=mp_known; value(p)=0; mp_free_node(mp, q,dep_node_size); - } else { - mp_type(p)=mp_dependent; mp_new_dep(mp, p,q); - } - mp_recycle_value(mp, mp->cur_exp); -} - -@ This code uses the fact that |red_part_loc| and |green_part_loc| -are synonymous with |x_part_loc| and |y_part_loc|. - -@<Scan the rest of a delimited set of numerics@>= -{ -p=mp_stash_cur_exp(mp); -mp_get_x_next(mp); mp_scan_expression(mp); -@<Make sure the second part of a pair or color has a numeric type@>; -q=mp_get_node(mp, value_node_size); mp_name_type(q)=mp_capsule; -if ( mp->cur_cmd==comma ) mp_type(q)=mp_color_type; -else mp_type(q)=mp_pair_type; -mp_init_big_node(mp, q); r=value(q); -mp_stash_in(mp, y_part_loc(r)); -mp_unstash_cur_exp(mp, p); -mp_stash_in(mp, x_part_loc(r)); -if ( mp->cur_cmd==comma ) { - @<Scan the last of a triplet of numerics@>; -} -if ( mp->cur_cmd==comma ) { - mp_type(q)=mp_cmykcolor_type; - mp_init_big_node(mp, q); t=value(q); - mp->mem[cyan_part_loc(t)]=mp->mem[red_part_loc(r)]; - value(cyan_part_loc(t))=value(red_part_loc(r)); - mp->mem[magenta_part_loc(t)]=mp->mem[green_part_loc(r)]; - value(magenta_part_loc(t))=value(green_part_loc(r)); - mp->mem[yellow_part_loc(t)]=mp->mem[blue_part_loc(r)]; - value(yellow_part_loc(t))=value(blue_part_loc(r)); - mp_recycle_value(mp, r); - r=t; - @<Scan the last of a quartet of numerics@>; -} -mp_check_delimiter(mp, l_delim,r_delim); -mp->cur_type=mp_type(q); -mp->cur_exp=q; -} - -@ @<Make sure the second part of a pair or color has a numeric type@>= -if ( mp->cur_type<mp_known ) { - exp_err("Nonnumeric ypart has been replaced by 0"); -@.Nonnumeric...replaced by 0@> - help4("I've started to scan a pair `(a,b)' or a color `(a,b,c)';", - "but after finding a nice `a' I found a `b' that isn't", - "of numeric type. So I've changed that part to zero.", - "(The b that I didn't like appears above the error message.)"); - mp_put_get_flush_error(mp, 0); -} - -@ @<Scan the last of a triplet of numerics@>= -{ - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type<mp_known ) { - exp_err("Nonnumeric third part has been replaced by 0"); -@.Nonnumeric...replaced by 0@> - help3("I've just scanned a color `(a,b,c)' or cmykcolor(a,b,c,d); but the `c'", - "isn't of numeric type. So I've changed that part to zero.", - "(The c that I didn't like appears above the error message.)"); - mp_put_get_flush_error(mp, 0); - } - mp_stash_in(mp, blue_part_loc(r)); -} - -@ @<Scan the last of a quartet of numerics@>= -{ - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type<mp_known ) { - exp_err("Nonnumeric blackpart has been replaced by 0"); -@.Nonnumeric...replaced by 0@> - help3("I've just scanned a cmykcolor `(c,m,y,k)'; but the `k' isn't", - "of numeric type. So I've changed that part to zero.", - "(The k that I didn't like appears above the error message.)"); - mp_put_get_flush_error(mp, 0); - } - mp_stash_in(mp, black_part_loc(r)); -} - -@ The local variable |group_line| keeps track of the line -where a \&{begingroup} command occurred; this will be useful -in an error message if the group doesn't actually end. - -@<Other local variables for |scan_primary|@>= -integer group_line; /* where a group began */ - -@ @<Scan a grouped primary@>= -{ - group_line=mp_true_line(mp); - if ( mp->internal[mp_tracing_commands]>0 ) show_cur_cmd_mod; - save_boundary_item(p); - do { - mp_do_statement(mp); /* ends with |cur_cmd>=semicolon| */ - } while (mp->cur_cmd==semicolon); - if ( mp->cur_cmd!=end_group ) { - print_err("A group begun on line "); -@.A group...never ended@> - mp_print_int(mp, group_line); - mp_print(mp, " never ended"); - help2("I saw a `begingroup' back there that hasn't been matched", - "by `endgroup'. So I've inserted `endgroup' now."); - mp_back_error(mp); mp->cur_cmd=end_group; - } - mp_unsave(mp); - /* this might change |cur_type|, if independent variables are recycled */ - if ( mp->internal[mp_tracing_commands]>0 ) show_cur_cmd_mod; -} - -@ @<Scan a string constant@>= -{ - mp->cur_type=mp_string_type; mp->cur_exp=mp->cur_mod; -} - -@ Later we'll come to procedures that perform actual operations like -addition, square root, and so on; our purpose now is to do the parsing. -But we might as well mention those future procedures now, so that the -suspense won't be too bad: - -\smallskip -|do_nullary(c)| does primitive operations that have no operands (e.g., -`\&{true}' or `\&{pencircle}'); - -\smallskip -|do_unary(c)| applies a primitive operation to the current expression; - -\smallskip -|do_binary(p,c)| applies a primitive operation to the capsule~|p| -and the current expression. - -@<Scan a nullary operation@>=mp_do_nullary(mp, mp->cur_mod) - -@ @<Scan a unary operation@>= -{ - c=mp->cur_mod; mp_get_x_next(mp); mp_scan_primary(mp); - mp_do_unary(mp, c); goto DONE; -} - -@ A numeric token might be a primary by itself, or it might be the -numerator of a fraction composed solely of numeric tokens, or it might -multiply the primary that follows (provided that the primary doesn't begin -with a plus sign or a minus sign). The code here uses the facts that -|max_primary_command=plus_or_minus| and -|max_primary_command-1=numeric_token|. If a fraction is found that is less -than unity, we try to retain higher precision when we use it in scalar -multiplication. - -@<Other local variables for |scan_primary|@>= -scaled num,denom; /* for primaries that are fractions, like `1/2' */ - -@ @<Scan a primary that starts with a numeric token@>= -{ - mp->cur_exp=mp->cur_mod; mp->cur_type=mp_known; mp_get_x_next(mp); - if ( mp->cur_cmd!=slash ) { - num=0; denom=0; - } else { - mp_get_x_next(mp); - if ( mp->cur_cmd!=numeric_token ) { - mp_back_input(mp); - mp->cur_cmd=slash; mp->cur_mod=over; mp->cur_sym=frozen_slash; - goto DONE; - } - num=mp->cur_exp; denom=mp->cur_mod; - if ( denom==0 ) { @<Protest division by zero@>; } - else { mp->cur_exp=mp_make_scaled(mp, num,denom); } - check_arith; mp_get_x_next(mp); - } - if ( mp->cur_cmd>=min_primary_command ) { - if ( mp->cur_cmd<numeric_token ) { /* in particular, |cur_cmd<>plus_or_minus| */ - p=mp_stash_cur_exp(mp); mp_scan_primary(mp); - if ( (abs(num)>=abs(denom))||(mp->cur_type<mp_color_type) ) { - mp_do_binary(mp, p,times); - } else { - mp_frac_mult(mp, num,denom); - mp_free_node(mp, p,value_node_size); - } - } - } - goto DONE; -} - -@ @<Protest division...@>= -{ - print_err("Division by zero"); -@.Division by zero@> - help1("I'll pretend that you meant to divide by 1."); mp_error(mp); -} - -@ @<Scan a binary operation with `\&{of}' between its operands@>= -{ - c=mp->cur_mod; mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_cmd!=of_token ) { - mp_missing_err(mp, "of"); mp_print(mp, " for "); - mp_print_cmd_mod(mp, primary_binary,c); -@.Missing `of'@> - help1("I've got the first argument; will look now for the other."); - mp_back_error(mp); - } - p=mp_stash_cur_exp(mp); mp_get_x_next(mp); mp_scan_primary(mp); - mp_do_binary(mp, p,c); goto DONE; -} - -@ @<Convert a suffix to a string@>= -{ - mp_get_x_next(mp); mp_scan_suffix(mp); - mp->old_setting=mp->selector; mp->selector=new_string; - mp_show_token_list(mp, mp->cur_exp,null,100000,0); - mp_flush_token_list(mp, mp->cur_exp); - mp->cur_exp=mp_make_string(mp); mp->selector=mp->old_setting; - mp->cur_type=mp_string_type; - goto DONE; -} - -@ If an internal quantity appears all by itself on the left of an -assignment, we return a token list of length one, containing the address -of the internal quantity plus |hash_end|. (This accords with the conventions -of the save stack, as described earlier.) - -@<Scan an internal...@>= -{ - q=mp->cur_mod; - if ( my_var_flag==assignment ) { - mp_get_x_next(mp); - if ( mp->cur_cmd==assignment ) { - mp->cur_exp=mp_get_avail(mp); - mp_info(mp->cur_exp)=q+hash_end; mp->cur_type=mp_token_list; - goto DONE; - } - mp_back_input(mp); - } - mp->cur_type=mp_known; mp->cur_exp=mp->internal[q]; -} - -@ The most difficult part of |scan_primary| has been saved for last, since -it was necessary to build up some confidence first. We can now face the task -of scanning a variable. - -As we scan a variable, we build a token list containing the relevant -names and subscript values, simultaneously following along in the -``collective'' structure to see if we are actually dealing with a macro -instead of a value. - -The local variables |pre_head| and |post_head| will point to the beginning -of the prefix and suffix lists; |tail| will point to the end of the list -that is currently growing. - -Another local variable, |tt|, contains partial information about the -declared type of the variable-so-far. If |tt>=mp_unsuffixed_macro|, the -relation |tt=mp_type(q)| will always hold. If |tt=undefined|, the routine -doesn't bother to update its information about type. And if -|undefined<tt<mp_unsuffixed_macro|, the precise value of |tt| isn't critical. - -@ @<Other local variables for |scan_primary|@>= -pointer pre_head,post_head,tail; - /* prefix and suffix list variables */ -quarterword tt; /* approximation to the type of the variable-so-far */ -pointer t; /* a token */ -pointer macro_ref = 0; /* reference count for a suffixed macro */ - -@ @<Scan a variable primary...@>= -{ - fast_get_avail(pre_head); tail=pre_head; post_head=null; tt=mp_vacuous; - while (1) { - t=mp_cur_tok(mp); mp_link(tail)=t; - if ( tt!=undefined ) { - @<Find the approximate type |tt| and corresponding~|q|@>; - if ( tt>=mp_unsuffixed_macro ) { - @<Either begin an unsuffixed macro call or - prepare for a suffixed one@>; - } - } - mp_get_x_next(mp); tail=t; - if ( mp->cur_cmd==left_bracket ) { - @<Scan for a subscript; replace |cur_cmd| by |numeric_token| if found@>; - } - if ( mp->cur_cmd>max_suffix_token ) break; - if ( mp->cur_cmd<min_suffix_token ) break; - } /* now |cur_cmd| is |internal_quantity|, |tag_token|, or |numeric_token| */ - @<Handle unusual cases that masquerade as variables, and |goto restart| - or |goto done| if appropriate; - otherwise make a copy of the variable and |goto done|@>; -} - -@ @<Either begin an unsuffixed macro call or...@>= -{ - mp_link(tail)=null; - if ( tt>mp_unsuffixed_macro ) { /* |tt=mp_suffixed_macro| */ - post_head=mp_get_avail(mp); tail=post_head; mp_link(tail)=t; - tt=undefined; macro_ref=value(q); add_mac_ref(macro_ref); - } else { - @<Set up unsuffixed macro call and |goto restart|@>; - } -} - -@ @<Scan for a subscript; replace |cur_cmd| by |numeric_token| if found@>= -{ - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_cmd!=right_bracket ) { - @<Put the left bracket and the expression back to be rescanned@>; - } else { - if ( mp->cur_type!=mp_known ) mp_bad_subscript(mp); - mp->cur_cmd=numeric_token; mp->cur_mod=mp->cur_exp; mp->cur_sym=0; - } -} - -@ The left bracket that we thought was introducing a subscript might have -actually been the left bracket in a mediation construction like `\.{x[a,b]}'. -So we don't issue an error message at this point; but we do want to back up -so as to avoid any embarrassment about our incorrect assumption. - -@<Put the left bracket and the expression back to be rescanned@>= -{ - mp_back_input(mp); /* that was the token following the current expression */ - mp_back_expr(mp); mp->cur_cmd=left_bracket; - mp->cur_mod=0; mp->cur_sym=frozen_left_bracket; -} - -@ Here's a routine that puts the current expression back to be read again. - -@c -static void mp_back_expr (MP mp) { - pointer p; /* capsule token */ - p=mp_stash_cur_exp(mp); mp_link(p)=null; back_list(p); -} - -@ Unknown subscripts lead to the following error message. - -@c -static void mp_bad_subscript (MP mp) { - exp_err("Improper subscript has been replaced by zero"); -@.Improper subscript...@> - help3("A bracketed subscript must have a known numeric value;", - "unfortunately, what I found was the value that appears just", - "above this error message. So I'll try a zero subscript."); - mp_flush_error(mp, 0); -} - -@ Every time we call |get_x_next|, there's a chance that the variable we've -been looking at will disappear. Thus, we cannot safely keep |q| pointing -into the variable structure; we need to start searching from the root each time. - -@<Find the approximate type |tt| and corresponding~|q|@>= -@^inner loop@> -{ - p=mp_link(pre_head); q=mp_info(p); tt=undefined; - if ( eq_type(q) % outer_tag==tag_token ) { - q=equiv(q); - if ( q==null ) goto DONE2; - while (1) { - p=mp_link(p); - if ( p==null ) { - tt=mp_type(q); goto DONE2; - }; - if ( mp_type(q)!=mp_structured ) goto DONE2; - q=mp_link(attr_head(q)); /* the |collective_subscript| attribute */ - if ( p>=mp->hi_mem_min ) { /* it's not a subscript */ - do { q=mp_link(q); } while (! (attr_loc(q)>=mp_info(p))); - if ( attr_loc(q)>mp_info(p) ) goto DONE2; - } - } - } -DONE2: - ; -} - -@ How do things stand now? Well, we have scanned an entire variable name, -including possible subscripts and/or attributes; |cur_cmd|, |cur_mod|, and -|cur_sym| represent the token that follows. If |post_head=null|, a -token list for this variable name starts at |mp_link(pre_head)|, with all -subscripts evaluated. But if |post_head<>null|, the variable turned out -to be a suffixed macro; |pre_head| is the head of the prefix list, while -|post_head| is the head of a token list containing both `\.{\AT!}' and -the suffix. - -Our immediate problem is to see if this variable still exists. (Variable -structures can change drastically whenever we call |get_x_next|; users -aren't supposed to do this, but the fact that it is possible means that -we must be cautious.) - -The following procedure prints an error message when a variable -unexpectedly disappears. Its help message isn't quite right for -our present purposes, but we'll be able to fix that up. - -@c -static void mp_obliterated (MP mp,pointer q) { - print_err("Variable "); mp_show_token_list(mp, q,null,1000,0); - mp_print(mp, " has been obliterated"); -@.Variable...obliterated@> - help5("It seems you did a nasty thing---probably by accident,", - "but nevertheless you nearly hornswoggled me...", - "While I was evaluating the right-hand side of this", - "command, something happened, and the left-hand side", - "is no longer a variable! So I won't change anything."); -} - -@ If the variable does exist, we also need to check -for a few other special cases before deciding that a plain old ordinary -variable has, indeed, been scanned. - -@<Handle unusual cases that masquerade as variables...@>= -if ( post_head!=null ) { - @<Set up suffixed macro call and |goto restart|@>; -} -q=mp_link(pre_head); free_avail(pre_head); -if ( mp->cur_cmd==my_var_flag ) { - mp->cur_type=mp_token_list; mp->cur_exp=q; goto DONE; -} -p=mp_find_variable(mp, q); -if ( p!=null ) { - mp_make_exp_copy(mp, p); -} else { - mp_obliterated(mp, q); - mp->help_line[2]="While I was evaluating the suffix of this variable,"; - mp->help_line[1]="something was redefined, and it's no longer a variable!"; - mp->help_line[0]="In order to get back on my feet, I've inserted `0' instead."; - mp_put_get_flush_error(mp, 0); -} -mp_flush_node_list(mp, q); -goto DONE - -@ The only complication associated with macro calling is that the prefix -and ``at'' parameters must be packaged in an appropriate list of lists. - -@<Set up unsuffixed macro call and |goto restart|@>= -{ - p=mp_get_avail(mp); mp_info(pre_head)=mp_link(pre_head); mp_link(pre_head)=p; - mp_info(p)=t; mp_macro_call(mp, value(q),pre_head,null); - mp_get_x_next(mp); - goto RESTART; -} - -@ If the ``variable'' that turned out to be a suffixed macro no longer exists, -we don't care, because we have reserved a pointer (|macro_ref|) to its -token list. - -@<Set up suffixed macro call and |goto restart|@>= -{ - mp_back_input(mp); p=mp_get_avail(mp); q=mp_link(post_head); - mp_info(pre_head)=mp_link(pre_head); mp_link(pre_head)=post_head; - mp_info(post_head)=q; mp_link(post_head)=p; mp_info(p)=mp_link(q); mp_link(q)=null; - mp_macro_call(mp, macro_ref,pre_head,null); decr(ref_count(macro_ref)); - mp_get_x_next(mp); goto RESTART; -} - -@ Our remaining job is simply to make a copy of the value that has been -found. Some cases are harder than others, but complexity arises solely -because of the multiplicity of possible cases. - -@<Declare the procedure called |make_exp_copy|@>= -@<Declare subroutines needed by |make_exp_copy|@> -static void mp_make_exp_copy (MP mp,pointer p) { - pointer q,r,t; /* registers for list manipulation */ -RESTART: - mp->cur_type=mp_type(p); - switch (mp->cur_type) { - case mp_vacuous: case mp_boolean_type: case mp_known: - mp->cur_exp=value(p); break; - case unknown_types: - mp->cur_exp=mp_new_ring_entry(mp, p); - break; - case mp_string_type: - mp->cur_exp=value(p); add_str_ref(mp->cur_exp); - break; - case mp_picture_type: - mp->cur_exp=value(p);add_edge_ref(mp->cur_exp); - break; - case mp_pen_type: - mp->cur_exp=copy_pen(value(p)); - break; - case mp_path_type: - mp->cur_exp=mp_copy_path(mp, value(p)); - break; - case mp_transform_type: case mp_color_type: - case mp_cmykcolor_type: case mp_pair_type: - @<Copy the big node |p|@>; - break; - case mp_dependent: case mp_proto_dependent: - mp_encapsulate(mp, mp_copy_dep_list(mp, dep_list(p))); - break; - case mp_numeric_type: - new_indep(p); goto RESTART; - break; - case mp_independent: - q=mp_single_dependency(mp, p); - if ( q==mp->dep_final ){ - mp->cur_type=mp_known; mp->cur_exp=0; mp_free_node(mp, q,dep_node_size); - } else { - mp->cur_type=mp_dependent; mp_encapsulate(mp, q); - } - break; - default: - mp_confusion(mp, "copy"); -@:this can't happen copy}{\quad copy@> - break; - } -} - -@ The |encapsulate| subroutine assumes that |dep_final| is the -tail of dependency list~|p|. - -@<Declare subroutines needed by |make_exp_copy|@>= -static void mp_encapsulate (MP mp,pointer p) { - mp->cur_exp=mp_get_node(mp, value_node_size); mp_type(mp->cur_exp)=mp->cur_type; - mp_name_type(mp->cur_exp)=mp_capsule; mp_new_dep(mp, mp->cur_exp,p); -} - -@ The most tedious case arises when the user refers to a -\&{pair}, \&{color}, or \&{transform} variable; we must copy several fields, -each of which can be |independent|, |dependent|, |mp_proto_dependent|, -or |known|. - -@<Copy the big node |p|@>= -{ - if ( value(p)==null ) - mp_init_big_node(mp, p); - t=mp_get_node(mp, value_node_size); mp_name_type(t)=mp_capsule; mp_type(t)=mp->cur_type; - mp_init_big_node(mp, t); - q=value(p)+mp->big_node_size[mp->cur_type]; - r=value(t)+mp->big_node_size[mp->cur_type]; - do { - q=q-2; r=r-2; mp_install(mp, r,q); - } while (q!=value(p)); - mp->cur_exp=t; -} - -@ The |install| procedure copies a numeric field~|q| into field~|r| of -a big node that will be part of a capsule. - -@<Declare subroutines needed by |make_exp_copy|@>= -static void mp_install (MP mp,pointer r, pointer q) { - pointer p; /* temporary register */ - if ( mp_type(q)==mp_known ){ - value(r)=value(q); mp_type(r)=mp_known; - } else if ( mp_type(q)==mp_independent ) { - p=mp_single_dependency(mp, q); - if ( p==mp->dep_final ) { - mp_type(r)=mp_known; value(r)=0; mp_free_node(mp, p,dep_node_size); - } else { - mp_type(r)=mp_dependent; mp_new_dep(mp, r,p); - } - } else { - mp_type(r)=mp_type(q); mp_new_dep(mp, r,mp_copy_dep_list(mp, dep_list(q))); - } -} - -@ Expressions of the form `\.{a[b,c]}' are converted into -`\.{b+a*(c-b)}', without checking the types of \.b~or~\.c, -provided that \.a is numeric. - -@<Scan a mediation...@>= -{ - p=mp_stash_cur_exp(mp); mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_cmd!=comma ) { - @<Put the left bracket and the expression back...@>; - mp_unstash_cur_exp(mp, p); - } else { - q=mp_stash_cur_exp(mp); mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_cmd!=right_bracket ) { - mp_missing_err(mp, "]"); -@.Missing `]'@> - help3("I've scanned an expression of the form `a[b,c',", - "so a right bracket should have come next.", - "I shall pretend that one was there."); - mp_back_error(mp); - } - r=mp_stash_cur_exp(mp); mp_make_exp_copy(mp, q); - mp_do_binary(mp, r,minus); mp_do_binary(mp, p,times); - mp_do_binary(mp, q,plus); mp_get_x_next(mp); - } -} - -@ Here is a comparatively simple routine that is used to scan the -\&{suffix} parameters of a macro. - -@<Declare the basic parsing subroutines@>= -static void mp_scan_suffix (MP mp) { - pointer h,t; /* head and tail of the list being built */ - pointer p; /* temporary register */ - h=mp_get_avail(mp); t=h; - while (1) { - if ( mp->cur_cmd==left_bracket ) { - @<Scan a bracketed subscript and set |cur_cmd:=numeric_token|@>; - } - if ( mp->cur_cmd==numeric_token ) { - p=mp_new_num_tok(mp, mp->cur_mod); - } else if ((mp->cur_cmd==tag_token)||(mp->cur_cmd==internal_quantity) ) { - p=mp_get_avail(mp); mp_info(p)=mp->cur_sym; - } else { - break; - } - mp_link(t)=p; t=p; mp_get_x_next(mp); - } - mp->cur_exp=mp_link(h); free_avail(h); mp->cur_type=mp_token_list; -} - -@ @<Scan a bracketed subscript and set |cur_cmd:=numeric_token|@>= -{ - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type!=mp_known ) mp_bad_subscript(mp); - if ( mp->cur_cmd!=right_bracket ) { - mp_missing_err(mp, "]"); -@.Missing `]'@> - help3("I've seen a `[' and a subscript value, in a suffix,", - "so a right bracket should have come next.", - "I shall pretend that one was there."); - mp_back_error(mp); - } - mp->cur_cmd=numeric_token; mp->cur_mod=mp->cur_exp; -} - -@* \[38] Parsing secondary and higher expressions. - -After the intricacies of |scan_primary|\kern-1pt, -the |scan_secondary| routine is -refreshingly simple. It's not trivial, but the operations are relatively -straightforward; the main difficulty is, again, that expressions and data -structures might change drastically every time we call |get_x_next|, so a -cautious approach is mandatory. For example, a macro defined by -\&{primarydef} might have disappeared by the time its second argument has -been scanned; we solve this by increasing the reference count of its token -list, so that the macro can be called even after it has been clobbered. - -@<Declare the basic parsing subroutines@>= -static void mp_scan_secondary (MP mp) { - pointer p; /* for list manipulation */ - halfword c,d; /* operation codes or modifiers */ - pointer mac_name; /* token defined with \&{primarydef} */ -RESTART: - if ((mp->cur_cmd<min_primary_command)|| - (mp->cur_cmd>max_primary_command) ) - mp_bad_exp(mp, "A secondary"); -@.A secondary expression...@> - mp_scan_primary(mp); -CONTINUE: - if ( mp->cur_cmd<=max_secondary_command && - mp->cur_cmd>=min_secondary_command ) { - p=mp_stash_cur_exp(mp); - c=mp->cur_mod; d=mp->cur_cmd; - if ( d==secondary_primary_macro ) { - mac_name=mp->cur_sym; - add_mac_ref(c); - } - mp_get_x_next(mp); - mp_scan_primary(mp); - if ( d!=secondary_primary_macro ) { - mp_do_binary(mp, p,c); - } else { - mp_back_input(mp); - mp_binary_mac(mp, p,c,mac_name); - decr(ref_count(c)); - mp_get_x_next(mp); - goto RESTART; - } - goto CONTINUE; - } -} - -@ The following procedure calls a macro that has two parameters, -|p| and |cur_exp|. - -@c -static void mp_binary_mac (MP mp,pointer p, pointer c, pointer n) { - pointer q,r; /* nodes in the parameter list */ - q=mp_get_avail(mp); r=mp_get_avail(mp); mp_link(q)=r; - mp_info(q)=p; mp_info(r)=mp_stash_cur_exp(mp); - mp_macro_call(mp, c,q,n); -} - -@ The next procedure, |scan_tertiary|, is pretty much the same deal. - -@<Declare the basic parsing subroutines@>= -static void mp_scan_tertiary (MP mp) { - pointer p; /* for list manipulation */ - halfword c,d; /* operation codes or modifiers */ - pointer mac_name; /* token defined with \&{secondarydef} */ -RESTART: - if ((mp->cur_cmd<min_primary_command)|| - (mp->cur_cmd>max_primary_command) ) - mp_bad_exp(mp, "A tertiary"); -@.A tertiary expression...@> - mp_scan_secondary(mp); -CONTINUE: - if ( mp->cur_cmd<=max_tertiary_command ) { - if ( mp->cur_cmd>=min_tertiary_command ) { - p=mp_stash_cur_exp(mp); c=mp->cur_mod; d=mp->cur_cmd; - if ( d==tertiary_secondary_macro ) { - mac_name=mp->cur_sym; add_mac_ref(c); - }; - mp_get_x_next(mp); mp_scan_secondary(mp); - if ( d!=tertiary_secondary_macro ) { - mp_do_binary(mp, p,c); - } else { - mp_back_input(mp); mp_binary_mac(mp, p,c,mac_name); - decr(ref_count(c)); mp_get_x_next(mp); - goto RESTART; - } - goto CONTINUE; - } - } -} - -@ Finally we reach the deepest level in our quartet of parsing routines. -This one is much like the others; but it has an extra complication from -paths, which materialize here. - -@d continue_path 25 /* a label inside of |scan_expression| */ -@d finish_path 26 /* another */ - -@<Declare the basic parsing subroutines@>= -static void mp_scan_expression (MP mp) { - pointer p,q,r,pp,qq; /* for list manipulation */ - halfword c,d; /* operation codes or modifiers */ - int my_var_flag; /* initial value of |var_flag| */ - pointer mac_name; /* token defined with \&{tertiarydef} */ - boolean cycle_hit; /* did a path expression just end with `\&{cycle}'? */ - scaled x,y; /* explicit coordinates or tension at a path join */ - int t; /* knot type following a path join */ - t=0; y=0; x=0; - my_var_flag=mp->var_flag; mac_name=null; -RESTART: - if ((mp->cur_cmd<min_primary_command)|| - (mp->cur_cmd>max_primary_command) ) - mp_bad_exp(mp, "An"); -@.An expression...@> - mp_scan_tertiary(mp); -CONTINUE: - if ( mp->cur_cmd<=max_expression_command ) - if ( mp->cur_cmd>=min_expression_command ) { - if ( (mp->cur_cmd!=equals)||(my_var_flag!=assignment) ) { - p=mp_stash_cur_exp(mp); c=mp->cur_mod; d=mp->cur_cmd; - if ( d==expression_tertiary_macro ) { - mac_name=mp->cur_sym; add_mac_ref(c); - } - if ( (d<ampersand)||((d==ampersand)&& - ((mp_type(p)==mp_pair_type)||(mp_type(p)==mp_path_type))) ) { - @<Scan a path construction operation; - but |return| if |p| has the wrong type@>; - } else { - mp_get_x_next(mp); mp_scan_tertiary(mp); - if ( d!=expression_tertiary_macro ) { - mp_do_binary(mp, p,c); - } else { - mp_back_input(mp); mp_binary_mac(mp, p,c,mac_name); - decr(ref_count(c)); mp_get_x_next(mp); - goto RESTART; - } - } - goto CONTINUE; - } - } -} - -@ The reader should review the data structure conventions for paths before -hoping to understand the next part of this code. - -@<Scan a path construction operation...@>= -{ - cycle_hit=false; - @<Convert the left operand, |p|, into a partial path ending at~|q|; - but |return| if |p| doesn't have a suitable type@>; -CONTINUE_PATH: - @<Determine the path join parameters; - but |goto finish_path| if there's only a direction specifier@>; - if ( mp->cur_cmd==cycle ) { - @<Get ready to close a cycle@>; - } else { - mp_scan_tertiary(mp); - @<Convert the right operand, |cur_exp|, - into a partial path from |pp| to~|qq|@>; - } - @<Join the partial paths and reset |p| and |q| to the head and tail - of the result@>; - if ( mp->cur_cmd>=min_expression_command ) - if ( mp->cur_cmd<=ampersand ) if ( ! cycle_hit ) goto CONTINUE_PATH; -FINISH_PATH: - @<Choose control points for the path and put the result into |cur_exp|@>; -} - -@ @<Convert the left operand, |p|, into a partial path ending at~|q|...@>= -{ - mp_unstash_cur_exp(mp, p); - if ( mp->cur_type==mp_pair_type ) p=mp_new_knot(mp); - else if ( mp->cur_type==mp_path_type ) p=mp->cur_exp; - else return; - q=p; - while ( mp_link(q)!=p ) q=mp_link(q); - if ( mp_left_type(p)!=mp_endpoint ) { /* open up a cycle */ - r=mp_copy_knot(mp, p); mp_link(q)=r; q=r; - } - mp_left_type(p)=mp_open; mp_right_type(q)=mp_open; -} - -@ A pair of numeric values is changed into a knot node for a one-point path -when \MP\ discovers that the pair is part of a path. - -@c -static pointer mp_new_knot (MP mp) { /* convert a pair to a knot with two endpoints */ - pointer q; /* the new node */ - q=mp_get_node(mp, knot_node_size); mp_left_type(q)=mp_endpoint; - mp_right_type(q)=mp_endpoint; mp_originator(q)=mp_metapost_user; mp_link(q)=q; - mp_known_pair(mp); mp_x_coord(q)=mp->cur_x; mp_y_coord(q)=mp->cur_y; - return q; -} - -@ The |known_pair| subroutine sets |cur_x| and |cur_y| to the components -of the current expression, assuming that the current expression is a -pair of known numerics. Unknown components are zeroed, and the -current expression is flushed. - -@<Declarations@>= -static void mp_known_pair (MP mp); - -@ @c -void mp_known_pair (MP mp) { - pointer p; /* the pair node */ - if ( mp->cur_type!=mp_pair_type ) { - exp_err("Undefined coordinates have been replaced by (0,0)"); -@.Undefined coordinates...@> - help5("I need x and y numbers for this part of the path.", - "The value I found (see above) was no good;", - "so I'll try to keep going by using zero instead.", - "(Chapter 27 of The METAFONTbook explains that", -@:METAFONTbook}{\sl The {\logos METAFONT\/}book@> - "you might want to type `I ??" "?' now.)"); - mp_put_get_flush_error(mp, 0); mp->cur_x=0; mp->cur_y=0; - } else { - p=value(mp->cur_exp); - @<Make sure that both |x| and |y| parts of |p| are known; - copy them into |cur_x| and |cur_y|@>; - mp_flush_cur_exp(mp, 0); - } -} - -@ @<Make sure that both |x| and |y| parts of |p| are known...@>= -if ( mp_type(x_part_loc(p))==mp_known ) { - mp->cur_x=value(x_part_loc(p)); -} else { - mp_disp_err(mp, x_part_loc(p), - "Undefined x coordinate has been replaced by 0"); -@.Undefined coordinates...@> - help5("I need a `known' x value for this part of the path.", - "The value I found (see above) was no good;", - "so I'll try to keep going by using zero instead.", - "(Chapter 27 of The METAFONTbook explains that", -@:METAFONTbook}{\sl The {\logos METAFONT\/}book@> - "you might want to type `I ??" "?' now.)"); - mp_put_get_error(mp); mp_recycle_value(mp, x_part_loc(p)); mp->cur_x=0; -} -if ( mp_type(y_part_loc(p))==mp_known ) { - mp->cur_y=value(y_part_loc(p)); -} else { - mp_disp_err(mp, y_part_loc(p), - "Undefined y coordinate has been replaced by 0"); - help5("I need a `known' y value for this part of the path.", - "The value I found (see above) was no good;", - "so I'll try to keep going by using zero instead.", - "(Chapter 27 of The METAFONTbook explains that", - "you might want to type `I ??" "?' now.)"); - mp_put_get_error(mp); mp_recycle_value(mp, y_part_loc(p)); mp->cur_y=0; -} - -@ At this point |cur_cmd| is either |ampersand|, |left_brace|, or |path_join|. - -@<Determine the path join parameters...@>= -if ( mp->cur_cmd==left_brace ) { - @<Put the pre-join direction information into node |q|@>; -} -d=mp->cur_cmd; -if ( d==path_join ) { - @<Determine the tension and/or control points@>; -} else if ( d!=ampersand ) { - goto FINISH_PATH; -} -mp_get_x_next(mp); -if ( mp->cur_cmd==left_brace ) { - @<Put the post-join direction information into |x| and |t|@>; -} else if ( mp_right_type(q)!=mp_explicit ) { - t=mp_open; x=0; -} - -@ The |scan_direction| subroutine looks at the directional information -that is enclosed in braces, and also scans ahead to the following character. -A type code is returned, either |open| (if the direction was $(0,0)$), -or |curl| (if the direction was a curl of known value |cur_exp|), or -|given| (if the direction is given by the |angle| value that now -appears in |cur_exp|). - -There's nothing difficult about this subroutine, but the program is rather -lengthy because a variety of potential errors need to be nipped in the bud. - -@c -static quarterword mp_scan_direction (MP mp) { - int t; /* the type of information found */ - scaled x; /* an |x| coordinate */ - mp_get_x_next(mp); - if ( mp->cur_cmd==curl_command ) { - @<Scan a curl specification@>; - } else { - @<Scan a given direction@>; - } - if ( mp->cur_cmd!=right_brace ) { - mp_missing_err(mp, "}"); -@.Missing `\char`\}'@> - help3("I've scanned a direction spec for part of a path,", - "so a right brace should have come next.", - "I shall pretend that one was there."); - mp_back_error(mp); - } - mp_get_x_next(mp); - return t; -} - -@ @<Scan a curl specification@>= -{ mp_get_x_next(mp); mp_scan_expression(mp); -if ( (mp->cur_type!=mp_known)||(mp->cur_exp<0) ){ - exp_err("Improper curl has been replaced by 1"); -@.Improper curl@> - help1("A curl must be a known, nonnegative number."); - mp_put_get_flush_error(mp, unity); -} -t=mp_curl; -} - -@ @<Scan a given direction@>= -{ mp_scan_expression(mp); - if ( mp->cur_type>mp_pair_type ) { - @<Get given directions separated by commas@>; - } else { - mp_known_pair(mp); - } - if ( (mp->cur_x==0)&&(mp->cur_y==0) ) t=mp_open; - else { t=mp_given; mp->cur_exp=mp_n_arg(mp, mp->cur_x,mp->cur_y);} -} - -@ @<Get given directions separated by commas@>= -{ - if ( mp->cur_type!=mp_known ) { - exp_err("Undefined x coordinate has been replaced by 0"); -@.Undefined coordinates...@> - help5("I need a `known' x value for this part of the path.", - "The value I found (see above) was no good;", - "so I'll try to keep going by using zero instead.", - "(Chapter 27 of The METAFONTbook explains that", -@:METAFONTbook}{\sl The {\logos METAFONT\/}book@> - "you might want to type `I ??" "?' now.)"); - mp_put_get_flush_error(mp, 0); - } - x=mp->cur_exp; - if ( mp->cur_cmd!=comma ) { - mp_missing_err(mp, ","); -@.Missing `,'@> - help2("I've got the x coordinate of a path direction;", - "will look for the y coordinate next."); - mp_back_error(mp); - } - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type!=mp_known ) { - exp_err("Undefined y coordinate has been replaced by 0"); - help5("I need a `known' y value for this part of the path.", - "The value I found (see above) was no good;", - "so I'll try to keep going by using zero instead.", - "(Chapter 27 of The METAFONTbook explains that", - "you might want to type `I ??" "?' now.)"); - mp_put_get_flush_error(mp, 0); - } - mp->cur_y=mp->cur_exp; mp->cur_x=x; -} - -@ At this point |mp_right_type(q)| is usually |open|, but it may have been -set to some other value by a previous operation. We must maintain -the value of |mp_right_type(q)| in cases such as -`\.{..\{curl2\}z\{0,0\}..}'. - -@<Put the pre-join...@>= -{ - t=mp_scan_direction(mp); - if ( t!=mp_open ) { - mp_right_type(q)=t; right_given(q)=mp->cur_exp; - if ( mp_left_type(q)==mp_open ) { - mp_left_type(q)=t; left_given(q)=mp->cur_exp; - } /* note that |left_given(q)=left_curl(q)| */ - } -} - -@ Since |left_tension| and |mp_left_y| share the same position in knot nodes, -and since |left_given| is similarly equivalent to |mp_left_x|, we use -|x| and |y| to hold the given direction and tension information when -there are no explicit control points. - -@<Put the post-join...@>= -{ - t=mp_scan_direction(mp); - if ( mp_right_type(q)!=mp_explicit ) x=mp->cur_exp; - else t=mp_explicit; /* the direction information is superfluous */ -} - -@ @<Determine the tension and/or...@>= -{ - mp_get_x_next(mp); - if ( mp->cur_cmd==tension ) { - @<Set explicit tensions@>; - } else if ( mp->cur_cmd==controls ) { - @<Set explicit control points@>; - } else { - right_tension(q)=unity; y=unity; mp_back_input(mp); /* default tension */ - goto DONE; - }; - if ( mp->cur_cmd!=path_join ) { - mp_missing_err(mp, ".."); -@.Missing `..'@> - help1("A path join command should end with two dots."); - mp_back_error(mp); - } -DONE: - ; -} - -@ @<Set explicit tensions@>= -{ - mp_get_x_next(mp); y=mp->cur_cmd; - if ( mp->cur_cmd==at_least ) mp_get_x_next(mp); - mp_scan_primary(mp); - @<Make sure that the current expression is a valid tension setting@>; - if ( y==at_least ) negate(mp->cur_exp); - right_tension(q)=mp->cur_exp; - if ( mp->cur_cmd==and_command ) { - mp_get_x_next(mp); y=mp->cur_cmd; - if ( mp->cur_cmd==at_least ) mp_get_x_next(mp); - mp_scan_primary(mp); - @<Make sure that the current expression is a valid tension setting@>; - if ( y==at_least ) negate(mp->cur_exp); - } - y=mp->cur_exp; -} - -@ @d min_tension three_quarter_unit - -@<Make sure that the current expression is a valid tension setting@>= -if ( (mp->cur_type!=mp_known)||(mp->cur_exp<min_tension) ) { - exp_err("Improper tension has been set to 1"); -@.Improper tension@> - help1("The expression above should have been a number >=3/4."); - mp_put_get_flush_error(mp, unity); -} - -@ @<Set explicit control points@>= -{ - mp_right_type(q)=mp_explicit; t=mp_explicit; mp_get_x_next(mp); mp_scan_primary(mp); - mp_known_pair(mp); mp_right_x(q)=mp->cur_x; mp_right_y(q)=mp->cur_y; - if ( mp->cur_cmd!=and_command ) { - x=mp_right_x(q); y=mp_right_y(q); - } else { - mp_get_x_next(mp); mp_scan_primary(mp); - mp_known_pair(mp); x=mp->cur_x; y=mp->cur_y; - } -} - -@ @<Convert the right operand, |cur_exp|, into a partial path...@>= -{ - if ( mp->cur_type!=mp_path_type ) pp=mp_new_knot(mp); - else pp=mp->cur_exp; - qq=pp; - while ( mp_link(qq)!=pp ) qq=mp_link(qq); - if ( mp_left_type(pp)!=mp_endpoint ) { /* open up a cycle */ - r=mp_copy_knot(mp, pp); mp_link(qq)=r; qq=r; - } - mp_left_type(pp)=mp_open; mp_right_type(qq)=mp_open; -} - -@ If a person tries to define an entire path by saying `\.{(x,y)\&cycle}', -we silently change the specification to `\.{(x,y)..cycle}', since a cycle -shouldn't have length zero. - -@<Get ready to close a cycle@>= -{ - cycle_hit=true; mp_get_x_next(mp); pp=p; qq=p; - if ( d==ampersand ) if ( p==q ) { - d=path_join; right_tension(q)=unity; y=unity; - } -} - -@ @<Join the partial paths and reset |p| and |q|...@>= -{ -if ( d==ampersand ) { - if ( (mp_x_coord(q)!=mp_x_coord(pp))||(mp_y_coord(q)!=mp_y_coord(pp)) ) { - print_err("Paths don't touch; `&' will be changed to `..'"); -@.Paths don't touch@> - help3("When you join paths `p&q', the ending point of p", - "must be exactly equal to the starting point of q.", - "So I'm going to pretend that you said `p..q' instead."); - mp_put_get_error(mp); d=path_join; right_tension(q)=unity; y=unity; - } -} -@<Plug an opening in |mp_right_type(pp)|, if possible@>; -if ( d==ampersand ) { - @<Splice independent paths together@>; -} else { - @<Plug an opening in |mp_right_type(q)|, if possible@>; - mp_link(q)=pp; mp_left_y(pp)=y; - if ( t!=mp_open ) { mp_left_x(pp)=x; mp_left_type(pp)=t; }; -} -q=qq; -} - -@ @<Plug an opening in |mp_right_type(q)|...@>= -if ( mp_right_type(q)==mp_open ) { - if ( (mp_left_type(q)==mp_curl)||(mp_left_type(q)==mp_given) ) { - mp_right_type(q)=mp_left_type(q); right_given(q)=left_given(q); - } -} - -@ @<Plug an opening in |mp_right_type(pp)|...@>= -if ( mp_right_type(pp)==mp_open ) { - if ( (t==mp_curl)||(t==mp_given) ) { - mp_right_type(pp)=t; right_given(pp)=x; - } -} - -@ @<Splice independent paths together@>= -{ - if ( mp_left_type(q)==mp_open ) if ( mp_right_type(q)==mp_open ) { - mp_left_type(q)=mp_curl; left_curl(q)=unity; - } - if ( mp_right_type(pp)==mp_open ) if ( t==mp_open ) { - mp_right_type(pp)=mp_curl; right_curl(pp)=unity; - } - mp_right_type(q)=mp_right_type(pp); mp_link(q)=mp_link(pp); - mp_right_x(q)=mp_right_x(pp); mp_right_y(q)=mp_right_y(pp); - mp_free_node(mp, pp,knot_node_size); - if ( qq==pp ) qq=q; -} - -@ @<Choose control points for the path...@>= -if ( cycle_hit ) { - if ( d==ampersand ) p=q; -} else { - mp_left_type(p)=mp_endpoint; - if ( mp_right_type(p)==mp_open ) { - mp_right_type(p)=mp_curl; right_curl(p)=unity; - } - mp_right_type(q)=mp_endpoint; - if ( mp_left_type(q)==mp_open ) { - mp_left_type(q)=mp_curl; left_curl(q)=unity; - } - mp_link(q)=p; -} -mp_make_choices(mp, p); -mp->cur_type=mp_path_type; mp->cur_exp=p - -@ Finally, we sometimes need to scan an expression whose value is -supposed to be either |true_code| or |false_code|. - -@<Declare the basic parsing subroutines@>= -static void mp_get_boolean (MP mp) { - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type!=mp_boolean_type ) { - exp_err("Undefined condition will be treated as `false'"); -@.Undefined condition...@> - help2("The expression shown above should have had a definite", - "true-or-false value. I'm changing it to `false'."); - mp_put_get_flush_error(mp, false_code); mp->cur_type=mp_boolean_type; - } -} - -@* \[39] Doing the operations. -The purpose of parsing is primarily to permit people to avoid piles of -parentheses. But the real work is done after the structure of an expression -has been recognized; that's when new expressions are generated. We -turn now to the guts of \MP, which handles individual operators that -have come through the parsing mechanism. - -We'll start with the easy ones that take no operands, then work our way -up to operators with one and ultimately two arguments. In other words, -we will write the three procedures |do_nullary|, |do_unary|, and |do_binary| -that are invoked periodically by the expression scanners. - -First let's make sure that all of the primitive operators are in the -hash table. Although |scan_primary| and its relatives made use of the -\\{cmd} code for these operators, the \\{do} routines base everything -on the \\{mod} code. For example, |do_binary| doesn't care whether the -operation it performs is a |primary_binary| or |secondary_binary|, etc. - -@<Put each...@>= -mp_primitive(mp, "true",nullary,true_code); -@:true_}{\&{true} primitive@> -mp_primitive(mp, "false",nullary,false_code); -@:false_}{\&{false} primitive@> -mp_primitive(mp, "nullpicture",nullary,null_picture_code); -@:null_picture_}{\&{nullpicture} primitive@> -mp_primitive(mp, "nullpen",nullary,null_pen_code); -@:null_pen_}{\&{nullpen} primitive@> -mp_primitive(mp, "jobname",nullary,job_name_op); -@:job_name_}{\&{jobname} primitive@> -mp_primitive(mp, "readstring",nullary,read_string_op); -@:read_string_}{\&{readstring} primitive@> -mp_primitive(mp, "pencircle",nullary,pen_circle); -@:pen_circle_}{\&{pencircle} primitive@> -mp_primitive(mp, "normaldeviate",nullary,normal_deviate); -@:normal_deviate_}{\&{normaldeviate} primitive@> -mp_primitive(mp, "readfrom",unary,read_from_op); -@:read_from_}{\&{readfrom} primitive@> -mp_primitive(mp, "closefrom",unary,close_from_op); -@:close_from_}{\&{closefrom} primitive@> -mp_primitive(mp, "odd",unary,odd_op); -@:odd_}{\&{odd} primitive@> -mp_primitive(mp, "known",unary,known_op); -@:known_}{\&{known} primitive@> -mp_primitive(mp, "unknown",unary,unknown_op); -@:unknown_}{\&{unknown} primitive@> -mp_primitive(mp, "not",unary,not_op); -@:not_}{\&{not} primitive@> -mp_primitive(mp, "decimal",unary,decimal); -@:decimal_}{\&{decimal} primitive@> -mp_primitive(mp, "reverse",unary,reverse); -@:reverse_}{\&{reverse} primitive@> -mp_primitive(mp, "makepath",unary,make_path_op); -@:make_path_}{\&{makepath} primitive@> -mp_primitive(mp, "makepen",unary,make_pen_op); -@:make_pen_}{\&{makepen} primitive@> -mp_primitive(mp, "oct",unary,oct_op); -@:oct_}{\&{oct} primitive@> -mp_primitive(mp, "hex",unary,hex_op); -@:hex_}{\&{hex} primitive@> -mp_primitive(mp, "ASCII",unary,ASCII_op); -@:ASCII_}{\&{ASCII} primitive@> -mp_primitive(mp, "char",unary,char_op); -@:char_}{\&{char} primitive@> -mp_primitive(mp, "length",unary,length_op); -@:length_}{\&{length} primitive@> -mp_primitive(mp, "turningnumber",unary,turning_op); -@:turning_number_}{\&{turningnumber} primitive@> -mp_primitive(mp, "xpart",unary,x_part); -@:x_part_}{\&{xpart} primitive@> -mp_primitive(mp, "ypart",unary,y_part); -@:y_part_}{\&{ypart} primitive@> -mp_primitive(mp, "xxpart",unary,xx_part); -@:xx_part_}{\&{xxpart} primitive@> -mp_primitive(mp, "xypart",unary,xy_part); -@:xy_part_}{\&{xypart} primitive@> -mp_primitive(mp, "yxpart",unary,yx_part); -@:yx_part_}{\&{yxpart} primitive@> -mp_primitive(mp, "yypart",unary,yy_part); -@:yy_part_}{\&{yypart} primitive@> -mp_primitive(mp, "redpart",unary,red_part); -@:red_part_}{\&{redpart} primitive@> -mp_primitive(mp, "greenpart",unary,green_part); -@:green_part_}{\&{greenpart} primitive@> -mp_primitive(mp, "bluepart",unary,blue_part); -@:blue_part_}{\&{bluepart} primitive@> -mp_primitive(mp, "cyanpart",unary,cyan_part); -@:cyan_part_}{\&{cyanpart} primitive@> -mp_primitive(mp, "magentapart",unary,magenta_part); -@:magenta_part_}{\&{magentapart} primitive@> -mp_primitive(mp, "yellowpart",unary,yellow_part); -@:yellow_part_}{\&{yellowpart} primitive@> -mp_primitive(mp, "blackpart",unary,black_part); -@:black_part_}{\&{blackpart} primitive@> -mp_primitive(mp, "greypart",unary,grey_part); -@:grey_part_}{\&{greypart} primitive@> -mp_primitive(mp, "colormodel",unary,color_model_part); -@:color_model_part_}{\&{colormodel} primitive@> -mp_primitive(mp, "fontpart",unary,font_part); -@:font_part_}{\&{fontpart} primitive@> -mp_primitive(mp, "textpart",unary,text_part); -@:text_part_}{\&{textpart} primitive@> -mp_primitive(mp, "pathpart",unary,path_part); -@:path_part_}{\&{pathpart} primitive@> -mp_primitive(mp, "penpart",unary,pen_part); -@:pen_part_}{\&{penpart} primitive@> -mp_primitive(mp, "dashpart",unary,dash_part); -@:dash_part_}{\&{dashpart} primitive@> -mp_primitive(mp, "sqrt",unary,sqrt_op); -@:sqrt_}{\&{sqrt} primitive@> -mp_primitive(mp, "mexp",unary,mp_m_exp_op); -@:m_exp_}{\&{mexp} primitive@> -mp_primitive(mp, "mlog",unary,mp_m_log_op); -@:m_log_}{\&{mlog} primitive@> -mp_primitive(mp, "sind",unary,sin_d_op); -@:sin_d_}{\&{sind} primitive@> -mp_primitive(mp, "cosd",unary,cos_d_op); -@:cos_d_}{\&{cosd} primitive@> -mp_primitive(mp, "floor",unary,floor_op); -@:floor_}{\&{floor} primitive@> -mp_primitive(mp, "uniformdeviate",unary,uniform_deviate); -@:uniform_deviate_}{\&{uniformdeviate} primitive@> -mp_primitive(mp, "charexists",unary,char_exists_op); -@:char_exists_}{\&{charexists} primitive@> -mp_primitive(mp, "fontsize",unary,font_size); -@:font_size_}{\&{fontsize} primitive@> -mp_primitive(mp, "llcorner",unary,ll_corner_op); -@:ll_corner_}{\&{llcorner} primitive@> -mp_primitive(mp, "lrcorner",unary,lr_corner_op); -@:lr_corner_}{\&{lrcorner} primitive@> -mp_primitive(mp, "ulcorner",unary,ul_corner_op); -@:ul_corner_}{\&{ulcorner} primitive@> -mp_primitive(mp, "urcorner",unary,ur_corner_op); -@:ur_corner_}{\&{urcorner} primitive@> -mp_primitive(mp, "arclength",unary,arc_length); -@:arc_length_}{\&{arclength} primitive@> -mp_primitive(mp, "angle",unary,angle_op); -@:angle_}{\&{angle} primitive@> -mp_primitive(mp, "cycle",cycle,cycle_op); -@:cycle_}{\&{cycle} primitive@> -mp_primitive(mp, "stroked",unary,stroked_op); -@:stroked_}{\&{stroked} primitive@> -mp_primitive(mp, "filled",unary,filled_op); -@:filled_}{\&{filled} primitive@> -mp_primitive(mp, "textual",unary,textual_op); -@:textual_}{\&{textual} primitive@> -mp_primitive(mp, "clipped",unary,clipped_op); -@:clipped_}{\&{clipped} primitive@> -mp_primitive(mp, "bounded",unary,bounded_op); -@:bounded_}{\&{bounded} primitive@> -mp_primitive(mp, "+",plus_or_minus,plus); -@:+ }{\.{+} primitive@> -mp_primitive(mp, "-",plus_or_minus,minus); -@:- }{\.{-} primitive@> -mp_primitive(mp, "*",secondary_binary,times); -@:* }{\.{*} primitive@> -mp_primitive(mp, "/",slash,over); mp->eqtb[frozen_slash]=mp->eqtb[mp->cur_sym]; -@:/ }{\.{/} primitive@> -mp_primitive(mp, "++",tertiary_binary,pythag_add); -@:++_}{\.{++} primitive@> -mp_primitive(mp, "+-+",tertiary_binary,pythag_sub); -@:+-+_}{\.{+-+} primitive@> -mp_primitive(mp, "or",tertiary_binary,or_op); -@:or_}{\&{or} primitive@> -mp_primitive(mp, "and",and_command,and_op); -@:and_}{\&{and} primitive@> -mp_primitive(mp, "<",expression_binary,less_than); -@:< }{\.{<} primitive@> -mp_primitive(mp, "<=",expression_binary,less_or_equal); -@:<=_}{\.{<=} primitive@> -mp_primitive(mp, ">",expression_binary,greater_than); -@:> }{\.{>} primitive@> -mp_primitive(mp, ">=",expression_binary,greater_or_equal); -@:>=_}{\.{>=} primitive@> -mp_primitive(mp, "=",equals,equal_to); -@:= }{\.{=} primitive@> -mp_primitive(mp, "<>",expression_binary,unequal_to); -@:<>_}{\.{<>} primitive@> -mp_primitive(mp, "substring",primary_binary,substring_of); -@:substring_}{\&{substring} primitive@> -mp_primitive(mp, "subpath",primary_binary,subpath_of); -@:subpath_}{\&{subpath} primitive@> -mp_primitive(mp, "directiontime",primary_binary,direction_time_of); -@:direction_time_}{\&{directiontime} primitive@> -mp_primitive(mp, "point",primary_binary,point_of); -@:point_}{\&{point} primitive@> -mp_primitive(mp, "precontrol",primary_binary,precontrol_of); -@:precontrol_}{\&{precontrol} primitive@> -mp_primitive(mp, "postcontrol",primary_binary,postcontrol_of); -@:postcontrol_}{\&{postcontrol} primitive@> -mp_primitive(mp, "penoffset",primary_binary,pen_offset_of); -@:pen_offset_}{\&{penoffset} primitive@> -mp_primitive(mp, "arctime",primary_binary,arc_time_of); -@:arc_time_of_}{\&{arctime} primitive@> -mp_primitive(mp, "mpversion",nullary,mp_version); -@:mp_verison_}{\&{mpversion} primitive@> -mp_primitive(mp, "&",ampersand,concatenate); -@:!!!}{\.{\&} primitive@> -mp_primitive(mp, "rotated",secondary_binary,rotated_by); -@:rotated_}{\&{rotated} primitive@> -mp_primitive(mp, "slanted",secondary_binary,slanted_by); -@:slanted_}{\&{slanted} primitive@> -mp_primitive(mp, "scaled",secondary_binary,scaled_by); -@:scaled_}{\&{scaled} primitive@> -mp_primitive(mp, "shifted",secondary_binary,shifted_by); -@:shifted_}{\&{shifted} primitive@> -mp_primitive(mp, "transformed",secondary_binary,transformed_by); -@:transformed_}{\&{transformed} primitive@> -mp_primitive(mp, "xscaled",secondary_binary,x_scaled); -@:x_scaled_}{\&{xscaled} primitive@> -mp_primitive(mp, "yscaled",secondary_binary,y_scaled); -@:y_scaled_}{\&{yscaled} primitive@> -mp_primitive(mp, "zscaled",secondary_binary,z_scaled); -@:z_scaled_}{\&{zscaled} primitive@> -mp_primitive(mp, "infont",secondary_binary,in_font); -@:in_font_}{\&{infont} primitive@> -mp_primitive(mp, "intersectiontimes",tertiary_binary,intersect); -@:intersection_times_}{\&{intersectiontimes} primitive@> -mp_primitive(mp, "envelope",primary_binary,envelope_of); -@:envelope_}{\&{envelope} primitive@> - -@ @<Cases of |print_cmd...@>= -case nullary: -case unary: -case primary_binary: -case secondary_binary: -case tertiary_binary: -case expression_binary: -case cycle: -case plus_or_minus: -case slash: -case ampersand: -case equals: -case and_command: - mp_print_op(mp, m); - break; - -@ OK, let's look at the simplest \\{do} procedure first. - -@c @<Declare nullary action procedure@> -static void mp_do_nullary (MP mp,quarterword c) { - check_arith; - if ( mp->internal[mp_tracing_commands]>two ) - mp_show_cmd_mod(mp, nullary,c); - switch (c) { - case true_code: case false_code: - mp->cur_type=mp_boolean_type; mp->cur_exp=c; - break; - case null_picture_code: - mp->cur_type=mp_picture_type; - mp->cur_exp=mp_get_node(mp, edge_header_size); - mp_init_edges(mp, mp->cur_exp); - break; - case null_pen_code: - mp->cur_type=mp_pen_type; mp->cur_exp=mp_get_pen_circle(mp, 0); - break; - case normal_deviate: - mp->cur_type=mp_known; mp->cur_exp=mp_norm_rand(mp); - break; - case pen_circle: - mp->cur_type=mp_pen_type; mp->cur_exp=mp_get_pen_circle(mp, unity); - break; - case job_name_op: - if ( mp->job_name==NULL ) mp_open_log_file(mp); - mp->cur_type=mp_string_type; mp->cur_exp=rts(mp->job_name); - break; - case mp_version: - mp->cur_type=mp_string_type; - mp->cur_exp=intern(metapost_version) ; - break; - case read_string_op: - @<Read a string from the terminal@>; - break; - } /* there are no other cases */ - check_arith; -} - -@ @<Read a string...@>= -{ - if (mp->noninteractive || mp->interaction<=mp_nonstop_mode ) - mp_fatal_error(mp, "*** (cannot readstring in nonstop modes)"); - mp_begin_file_reading(mp); name=is_read; - limit=start; prompt_input(""); - mp_finish_read(mp); -} - -@ @<Declare nullary action procedure@>= -static void mp_finish_read (MP mp) { /* copy |buffer| line to |cur_exp| */ - size_t k; - str_room((int)mp->last-start); - for (k=(size_t)start;k<mp->last;k++) { - append_char(mp->buffer[k]); - } - mp_end_file_reading(mp); mp->cur_type=mp_string_type; - mp->cur_exp=mp_make_string(mp); -} - -@ Things get a bit more interesting when there's an operand. The -operand to |do_unary| appears in |cur_type| and |cur_exp|. - -@c @<Declare unary action procedures@> -static void mp_do_unary (MP mp,quarterword c) { - pointer p,q,r; /* for list manipulation */ - integer x; /* a temporary register */ - check_arith; - if ( mp->internal[mp_tracing_commands]>two ) - @<Trace the current unary operation@>; - switch (c) { - case plus: - if ( mp->cur_type<mp_color_type ) mp_bad_unary(mp, plus); - break; - case minus: - @<Negate the current expression@>; - break; - @<Additional cases of unary operators@>; - } /* there are no other cases */ - check_arith; -} - -@ The |nice_pair| function returns |true| if both components of a pair -are known. - -@<Declare unary action procedures@>= -static boolean mp_nice_pair (MP mp,integer p, quarterword t) { - if ( t==mp_pair_type ) { - p=value(p); - if ( mp_type(x_part_loc(p))==mp_known ) - if ( mp_type(y_part_loc(p))==mp_known ) - return true; - } - return false; -} - -@ The |nice_color_or_pair| function is analogous except that it also accepts -fully known colors. - -@<Declare unary action procedures@>= -static boolean mp_nice_color_or_pair (MP mp,integer p, quarterword t) { - pointer q,r; /* for scanning the big node */ - if ( (t!=mp_pair_type)&&(t!=mp_color_type)&&(t!=mp_cmykcolor_type) ) { - return false; - } else { - q=value(p); - r=q+mp->big_node_size[mp_type(p)]; - do { - r=r-2; - if ( mp_type(r)!=mp_known ) - return false; - } while (r!=q); - return true; - } -} - -@ @<Declare unary action...@>= -static void mp_print_known_or_unknown_type (MP mp,quarterword t, integer v) { - mp_print_char(mp, xord('(')); - if ( t>mp_known ) mp_print(mp, "unknown numeric"); - else { if ( (t==mp_pair_type)||(t==mp_color_type)||(t==mp_cmykcolor_type) ) - if ( ! mp_nice_color_or_pair(mp, v,t) ) mp_print(mp, "unknown "); - mp_print_type(mp, t); - } - mp_print_char(mp, xord(')')); -} - -@ @<Declare unary action...@>= -static void mp_bad_unary (MP mp,quarterword c) { - exp_err("Not implemented: "); mp_print_op(mp, c); -@.Not implemented...@> - mp_print_known_or_unknown_type(mp, mp->cur_type,mp->cur_exp); - help3("I'm afraid I don't know how to apply that operation to that", - "particular type. Continue, and I'll simply return the", - "argument (shown above) as the result of the operation."); - mp_put_get_error(mp); -} - -@ @<Trace the current unary operation@>= -{ - mp_begin_diagnostic(mp); mp_print_nl(mp, "{"); - mp_print_op(mp, c); mp_print_char(mp, xord('(')); - mp_print_exp(mp, null,0); /* show the operand, but not verbosely */ - mp_print(mp, ")}"); mp_end_diagnostic(mp, false); -} - -@ Negation is easy except when the current expression -is of type |independent|, or when it is a pair with one or more -|independent| components. - -It is tempting to argue that the negative of an independent variable -is an independent variable, hence we don't have to do anything when -negating it. The fallacy is that other dependent variables pointing -to the current expression must change the sign of their -coefficients if we make no change to the current expression. - -Instead, we work around the problem by copying the current expression -and recycling it afterwards (cf.~the |stash_in| routine). - -@<Negate the current expression@>= -switch (mp->cur_type) { -case mp_color_type: -case mp_cmykcolor_type: -case mp_pair_type: -case mp_independent: - q=mp->cur_exp; mp_make_exp_copy(mp, q); - if ( mp->cur_type==mp_dependent ) { - mp_negate_dep_list(mp, dep_list(mp->cur_exp)); - } else if ( mp->cur_type<=mp_pair_type ) { /* |mp_color_type| or |mp_pair_type| */ - p=value(mp->cur_exp); - r=p+mp->big_node_size[mp->cur_type]; - do { - r=r-2; - if ( mp_type(r)==mp_known ) negate(value(r)); - else mp_negate_dep_list(mp, dep_list(r)); - } while (r!=p); - } /* if |cur_type=mp_known| then |cur_exp=0| */ - mp_recycle_value(mp, q); mp_free_node(mp, q,value_node_size); - break; -case mp_dependent: -case mp_proto_dependent: - mp_negate_dep_list(mp, dep_list(mp->cur_exp)); - break; -case mp_known: - negate(mp->cur_exp); - break; -default: - mp_bad_unary(mp, minus); - break; -} - -@ @<Declare unary action...@>= -static void mp_negate_dep_list (MP mp,pointer p) { - while (1) { - negate(value(p)); - if ( mp_info(p)==null ) return; - p=mp_link(p); - } -} - -@ @<Additional cases of unary operators@>= -case not_op: - if ( mp->cur_type!=mp_boolean_type ) mp_bad_unary(mp, not_op); - else mp->cur_exp=true_code+false_code-mp->cur_exp; - break; - -@ @d three_sixty_units 23592960 /* that's |360*unity| */ -@d boolean_reset(A) if ( (A) ) mp->cur_exp=true_code; else mp->cur_exp=false_code - -@<Additional cases of unary operators@>= -case sqrt_op: -case mp_m_exp_op: -case mp_m_log_op: -case sin_d_op: -case cos_d_op: -case floor_op: -case uniform_deviate: -case odd_op: -case char_exists_op: - if ( mp->cur_type!=mp_known ) { - mp_bad_unary(mp, c); - } else { - switch (c) { - case sqrt_op:mp->cur_exp=mp_square_rt(mp, mp->cur_exp);break; - case mp_m_exp_op:mp->cur_exp=mp_m_exp(mp, mp->cur_exp);break; - case mp_m_log_op:mp->cur_exp=mp_m_log(mp, mp->cur_exp);break; - case sin_d_op: - case cos_d_op: - mp_n_sin_cos(mp, (mp->cur_exp % three_sixty_units)*16); - if ( c==sin_d_op ) mp->cur_exp=mp_round_fraction(mp, mp->n_sin); - else mp->cur_exp=mp_round_fraction(mp, mp->n_cos); - break; - case floor_op:mp->cur_exp=mp_floor_scaled(mp, mp->cur_exp);break; - case uniform_deviate:mp->cur_exp=mp_unif_rand(mp, mp->cur_exp);break; - case odd_op: - boolean_reset(odd(mp_round_unscaled(mp, mp->cur_exp))); - mp->cur_type=mp_boolean_type; - break; - case char_exists_op: - @<Determine if a character has been shipped out@>; - break; - } /* there are no other cases */ - } - break; - -@ @<Additional cases of unary operators@>= -case angle_op: - if ( mp_nice_pair(mp, mp->cur_exp,mp->cur_type) ) { - p=value(mp->cur_exp); - x=mp_n_arg(mp, value(x_part_loc(p)),value(y_part_loc(p))); - if ( x>=0 ) mp_flush_cur_exp(mp, (x+8)/ 16); - else mp_flush_cur_exp(mp, -((-x+8)/ 16)); - } else { - mp_bad_unary(mp, angle_op); - } - break; - -@ If the current expression is a pair, but the context wants it to -be a path, we call |pair_to_path|. - -@<Declare unary action...@>= -static void mp_pair_to_path (MP mp) { - mp->cur_exp=mp_new_knot(mp); - mp->cur_type=mp_path_type; -} - -@ -@d pict_color_type(A) ((mp_link(dummy_loc(mp->cur_exp))!=null) && - (has_color(mp_link(dummy_loc(mp->cur_exp)))) && - ((mp_color_model(mp_link(dummy_loc(mp->cur_exp)))==A) - || - ((mp_color_model(mp_link(dummy_loc(mp->cur_exp)))==mp_uninitialized_model) && - (mp->internal[mp_default_color_model]/unity)==(A)))) - -@<Additional cases of unary operators@>= -case x_part: -case y_part: - if ( (mp->cur_type==mp_pair_type)||(mp->cur_type==mp_transform_type) ) - mp_take_part(mp, c); - else if ( mp->cur_type==mp_picture_type ) mp_take_pict_part(mp, c); - else mp_bad_unary(mp, c); - break; -case xx_part: -case xy_part: -case yx_part: -case yy_part: - if ( mp->cur_type==mp_transform_type ) mp_take_part(mp, c); - else if ( mp->cur_type==mp_picture_type ) mp_take_pict_part(mp, c); - else mp_bad_unary(mp, c); - break; -case red_part: -case green_part: -case blue_part: - if ( mp->cur_type==mp_color_type ) mp_take_part(mp, c); - else if ( mp->cur_type==mp_picture_type ) { - if pict_color_type(mp_rgb_model) mp_take_pict_part(mp, c); - else mp_bad_color_part(mp, c); - } - else mp_bad_unary(mp, c); - break; -case cyan_part: -case magenta_part: -case yellow_part: -case black_part: - if ( mp->cur_type==mp_cmykcolor_type) mp_take_part(mp, c); - else if ( mp->cur_type==mp_picture_type ) { - if pict_color_type(mp_cmyk_model) mp_take_pict_part(mp, c); - else mp_bad_color_part(mp, c); - } - else mp_bad_unary(mp, c); - break; -case grey_part: - if ( mp->cur_type==mp_known ) mp->cur_exp=value(c); - else if ( mp->cur_type==mp_picture_type ) { - if pict_color_type(mp_grey_model) mp_take_pict_part(mp, c); - else mp_bad_color_part(mp, c); - } - else mp_bad_unary(mp, c); - break; -case color_model_part: - if ( mp->cur_type==mp_picture_type ) mp_take_pict_part(mp, c); - else mp_bad_unary(mp, c); - break; - -@ @<Declarations@>= -static void mp_bad_color_part(MP mp, quarterword c); - -@ @c -static void mp_bad_color_part(MP mp, quarterword c) { - pointer p; /* the big node */ - p=mp_link(dummy_loc(mp->cur_exp)); - exp_err("Wrong picture color model: "); mp_print_op(mp, c); -@.Wrong picture color model...@> - if (mp_color_model(p)==mp_grey_model) - mp_print(mp, " of grey object"); - else if (mp_color_model(p)==mp_cmyk_model) - mp_print(mp, " of cmyk object"); - else if (mp_color_model(p)==mp_rgb_model) - mp_print(mp, " of rgb object"); - else if (mp_color_model(p)==mp_no_model) - mp_print(mp, " of marking object"); - else - mp_print(mp," of defaulted object"); - help3("You can only ask for the redpart, greenpart, bluepart of a rgb object,", - "the cyanpart, magentapart, yellowpart or blackpart of a cmyk object, ", - "or the greypart of a grey object. No mixing and matching, please."); - mp_error(mp); - if (c==black_part) - mp_flush_cur_exp(mp,unity); - else - mp_flush_cur_exp(mp,0); -} - -@ In the following procedure, |cur_exp| points to a capsule, which points to -a big node. We want to delete all but one part of the big node. - -@<Declare unary action...@>= -static void mp_take_part (MP mp,quarterword c) { - pointer p; /* the big node */ - p=value(mp->cur_exp); value(temp_val)=p; mp_type(temp_val)=mp->cur_type; - mp_link(p)=temp_val; mp_free_node(mp, mp->cur_exp,value_node_size); - mp_make_exp_copy(mp, p+mp->sector_offset[c+mp_x_part_sector-x_part]); - mp_recycle_value(mp, temp_val); -} - -@ @<Initialize table entries...@>= -mp_name_type(temp_val)=mp_capsule; - -@ @<Additional cases of unary operators@>= -case font_part: -case text_part: -case path_part: -case pen_part: -case dash_part: - if ( mp->cur_type==mp_picture_type ) mp_take_pict_part(mp, c); - else mp_bad_unary(mp, c); - break; - -@ @<Declarations@>= -static void mp_scale_edges (MP mp); - -@ @<Declare unary action...@>= -static void mp_take_pict_part (MP mp,quarterword c) { - pointer p; /* first graphical object in |cur_exp| */ - p=mp_link(dummy_loc(mp->cur_exp)); - if ( p!=null ) { - switch (c) { - case x_part: case y_part: case xx_part: - case xy_part: case yx_part: case yy_part: - if ( mp_type(p)==mp_text_code ) mp_flush_cur_exp(mp, text_trans_part(p+c)); - else goto NOT_FOUND; - break; - case red_part: case green_part: case blue_part: - if ( has_color(p) ) mp_flush_cur_exp(mp, obj_color_part(p+c)); - else goto NOT_FOUND; - break; - case cyan_part: case magenta_part: case yellow_part: - case black_part: - if ( has_color(p) ) { - if ( mp_color_model(p)==mp_uninitialized_model && c==black_part) - mp_flush_cur_exp(mp, unity); - else - mp_flush_cur_exp(mp, obj_color_part(p+c+(red_part-cyan_part))); - } else goto NOT_FOUND; - break; - case grey_part: - if ( has_color(p) ) - mp_flush_cur_exp(mp, obj_color_part(p+c+(red_part-grey_part))); - else goto NOT_FOUND; - break; - case color_model_part: - if ( has_color(p) ) { - if ( mp_color_model(p)==mp_uninitialized_model ) - mp_flush_cur_exp(mp, mp->internal[mp_default_color_model]); - else - mp_flush_cur_exp(mp, mp_color_model(p)*unity); - } else goto NOT_FOUND; - break; - @<Handle other cases in |take_pict_part| or |goto not_found|@>; - } /* all cases have been enumerated */ - return; - }; -NOT_FOUND: - @<Convert the current expression to a null value appropriate - for |c|@>; -} - -@ @<Handle other cases in |take_pict_part| or |goto not_found|@>= -case text_part: - if ( mp_type(p)!=mp_text_code ) goto NOT_FOUND; - else { - mp_flush_cur_exp(mp, mp_text_p(p)); - add_str_ref(mp->cur_exp); - mp->cur_type=mp_string_type; - }; - break; -case font_part: - if ( mp_type(p)!=mp_text_code ) goto NOT_FOUND; - else { - mp_flush_cur_exp(mp, rts(mp->font_name[mp_font_n(p)])); - add_str_ref(mp->cur_exp); - mp->cur_type=mp_string_type; - }; - break; -case path_part: - if ( mp_type(p)==mp_text_code ) goto NOT_FOUND; - else if ( is_stop(p) ) mp_confusion(mp, "pict"); -@:this can't happen pict}{\quad pict@> - else { - mp_flush_cur_exp(mp, mp_copy_path(mp, mp_path_p(p))); - mp->cur_type=mp_path_type; - } - break; -case pen_part: - if ( ! has_pen(p) ) goto NOT_FOUND; - else { - if ( mp_pen_p(p)==null ) goto NOT_FOUND; - else { mp_flush_cur_exp(mp, copy_pen(mp_pen_p(p))); - mp->cur_type=mp_pen_type; - }; - } - break; -case dash_part: - if ( mp_type(p)!=mp_stroked_code ) goto NOT_FOUND; - else { if ( mp_dash_p(p)==null ) goto NOT_FOUND; - else { add_edge_ref(mp_dash_p(p)); - mp->se_sf=dash_scale(p); - mp->se_pic=mp_dash_p(p); - mp_scale_edges(mp); - mp_flush_cur_exp(mp, mp->se_pic); - mp->cur_type=mp_picture_type; - }; - } - break; - -@ Since |scale_edges| had to be declared |forward|, it had to be declared as a -parameterless procedure even though it really takes two arguments and updates -one of them. Hence the following globals are needed. - -@<Global...@>= -pointer se_pic; /* edge header used and updated by |scale_edges| */ -scaled se_sf; /* the scale factor argument to |scale_edges| */ - -@ @<Convert the current expression to a null value appropriate...@>= -switch (c) { -case text_part: case font_part: - mp_flush_cur_exp(mp, null_str); - mp->cur_type=mp_string_type; - break; -case path_part: - mp_flush_cur_exp(mp, mp_get_node(mp, knot_node_size)); - mp_left_type(mp->cur_exp)=mp_endpoint; - mp_right_type(mp->cur_exp)=mp_endpoint; - mp_link(mp->cur_exp)=mp->cur_exp; - mp_x_coord(mp->cur_exp)=0; - mp_y_coord(mp->cur_exp)=0; - mp_originator(mp->cur_exp)=mp_metapost_user; - mp->cur_type=mp_path_type; - break; -case pen_part: - mp_flush_cur_exp(mp, mp_get_pen_circle(mp, 0)); - mp->cur_type=mp_pen_type; - break; -case dash_part: - mp_flush_cur_exp(mp, mp_get_node(mp, edge_header_size)); - mp_init_edges(mp, mp->cur_exp); - mp->cur_type=mp_picture_type; - break; -default: - mp_flush_cur_exp(mp, 0); - break; -} - -@ @<Additional cases of unary...@>= -case char_op: - if ( mp->cur_type!=mp_known ) { - mp_bad_unary(mp, char_op); - } else { - mp->cur_exp=mp_round_unscaled(mp, mp->cur_exp) % 256; - mp->cur_type=mp_string_type; - if ( mp->cur_exp<0 ) mp->cur_exp=mp->cur_exp+256; - } - break; -case decimal: - if ( mp->cur_type!=mp_known ) { - mp_bad_unary(mp, decimal); - } else { - mp->old_setting=mp->selector; mp->selector=new_string; - mp_print_scaled(mp, mp->cur_exp); mp->cur_exp=mp_make_string(mp); - mp->selector=mp->old_setting; mp->cur_type=mp_string_type; - } - break; -case oct_op: -case hex_op: -case ASCII_op: - if ( mp->cur_type!=mp_string_type ) mp_bad_unary(mp, c); - else mp_str_to_num(mp, c); - break; -case font_size: - if ( mp->cur_type!=mp_string_type ) mp_bad_unary(mp, font_size); - else @<Find the design size of the font whose name is |cur_exp|@>; - break; - -@ @<Declare unary action...@>= -static void mp_str_to_num (MP mp,quarterword c) { /* converts a string to a number */ - integer n; /* accumulator */ - ASCII_code m; /* current character */ - pool_pointer k; /* index into |str_pool| */ - int b; /* radix of conversion */ - boolean bad_char; /* did the string contain an invalid digit? */ - if ( c==ASCII_op ) { - if ( length(mp->cur_exp)==0 ) n=-1; - else n=mp->str_pool[mp->str_start[mp->cur_exp]]; - } else { - if ( c==oct_op ) b=8; else b=16; - n=0; bad_char=false; - for (k=mp->str_start[mp->cur_exp];k<str_stop(mp->cur_exp);k++) { - m=mp->str_pool[k]; - if ( (m>='0')&&(m<='9') ) m=m-'0'; - else if ( (m>='A')&&(m<='F') ) m=m-'A'+10; - else if ( (m>='a')&&(m<='f') ) m=m-'a'+10; - else { bad_char=true; m=0; }; - if ( (int)m>=b ) { bad_char=true; m=0; }; - if ( n<32768 / b ) n=n*b+m; else n=32767; - } - @<Give error messages if |bad_char| or |n>=4096|@>; - } - mp_flush_cur_exp(mp, n*unity); -} - -@ @<Give error messages if |bad_char|...@>= -if ( bad_char ) { - exp_err("String contains illegal digits"); -@.String contains illegal digits@> - if ( c==oct_op ) { - help1("I zeroed out characters that weren't in the range 0..7."); - } else { - help1("I zeroed out characters that weren't hex digits."); - } - mp_put_get_error(mp); -} -if ( (n>4095) ) { - if ( mp->internal[mp_warning_check]>0 ) { - print_err("Number too large ("); - mp_print_int(mp, n); mp_print_char(mp, xord(')')); -@.Number too large@> - help2("I have trouble with numbers greater than 4095; watch out.", - "(Set warningcheck:=0 to suppress this message.)"); - mp_put_get_error(mp); - } -} - -@ The length operation is somewhat unusual in that it applies to a variety -of different types of operands. - -@<Additional cases of unary...@>= -case length_op: - switch (mp->cur_type) { - case mp_string_type: mp_flush_cur_exp(mp, length(mp->cur_exp)*unity); break; - case mp_path_type: mp_flush_cur_exp(mp, mp_path_length(mp)); break; - case mp_known: mp->cur_exp=abs(mp->cur_exp); break; - case mp_picture_type: mp_flush_cur_exp(mp, mp_pict_length(mp)); break; - default: - if ( mp_nice_pair(mp, mp->cur_exp,mp->cur_type) ) - mp_flush_cur_exp(mp, mp_pyth_add(mp, - value(x_part_loc(value(mp->cur_exp))), - value(y_part_loc(value(mp->cur_exp))))); - else mp_bad_unary(mp, c); - break; - } - break; - -@ @<Declare unary action...@>= -static scaled mp_path_length (MP mp) { /* computes the length of the current path */ - scaled n; /* the path length so far */ - pointer p; /* traverser */ - p=mp->cur_exp; - if ( mp_left_type(p)==mp_endpoint ) n=-unity; else n=0; - do { p=mp_link(p); n=n+unity; } while (p!=mp->cur_exp); - return n; -} - -@ @<Declare unary action...@>= -static scaled mp_pict_length (MP mp) { - /* counts interior components in picture |cur_exp| */ - scaled n; /* the count so far */ - pointer p; /* traverser */ - n=0; - p=mp_link(dummy_loc(mp->cur_exp)); - if ( p!=null ) { - if ( is_start_or_stop(p) ) - if ( mp_skip_1component(mp, p)==null ) p=mp_link(p); - while ( p!=null ) { - skip_component(p) return n; - n=n+unity; - } - } - return n; -} - -@ Implement |turningnumber| - -@<Additional cases of unary...@>= -case turning_op: - if ( mp->cur_type==mp_pair_type ) mp_flush_cur_exp(mp, 0); - else if ( mp->cur_type!=mp_path_type ) mp_bad_unary(mp, turning_op); - else if ( mp_left_type(mp->cur_exp)==mp_endpoint ) - mp_flush_cur_exp(mp, 0); /* not a cyclic path */ - else - mp_flush_cur_exp(mp, mp_turn_cycles_wrapper(mp, mp->cur_exp)); - break; - -@ The function |an_angle| returns the value of the |angle| primitive, or $0$ if the -argument is |origin|. - -@<Declare unary action...@>= -static angle mp_an_angle (MP mp,scaled xpar, scaled ypar) { - if ( (! ((xpar==0) && (ypar==0))) ) - return mp_n_arg(mp, xpar,ypar); - return 0; -} - - -@ The actual turning number is (for the moment) computed in a C function -that receives eight integers corresponding to the four controlling points, -and returns a single angle. Besides those, we have to account for discrete -moves at the actual points. - -@d mp_floor(a) ((a)>=0 ? (int)(a) : -(int)(-(a))) -@d bezier_error (720*(256*256*16))+1 -@d mp_sign(v) ((v)>0 ? 1 : ((v)<0 ? -1 : 0 )) -@d mp_out(A) (double)((A)/(256*256*16)) -@d divisor (256*256) -@d double2angle(a) (int)mp_floor(a*256.0*256.0*16.0) - -@<Declare unary action...@>= -static angle mp_bezier_slope(MP mp, integer AX,integer AY,integer BX,integer BY, - integer CX,integer CY,integer DX,integer DY); - -@ @c -static angle mp_bezier_slope(MP mp, integer AX,integer AY,integer BX,integer BY, - integer CX,integer CY,integer DX,integer DY) { - double a, b, c; - integer deltax,deltay; - double ax,ay,bx,by,cx,cy,dx,dy; - angle xi = 0, xo = 0, xm = 0; - double res = 0; - ax=(double)(AX/divisor); ay=(double)(AY/divisor); - bx=(double)(BX/divisor); by=(double)(BY/divisor); - cx=(double)(CX/divisor); cy=(double)(CY/divisor); - dx=(double)(DX/divisor); dy=(double)(DY/divisor); - - deltax = (BX-AX); deltay = (BY-AY); - if (deltax==0 && deltay == 0) { deltax=(CX-AX); deltay=(CY-AY); } - if (deltax==0 && deltay == 0) { deltax=(DX-AX); deltay=(DY-AY); } - xi = mp_an_angle(mp,deltax,deltay); - - deltax = (CX-BX); deltay = (CY-BY); - xm = mp_an_angle(mp,deltax,deltay); - - deltax = (DX-CX); deltay = (DY-CY); - if (deltax==0 && deltay == 0) { deltax=(DX-BX); deltay=(DY-BY); } - if (deltax==0 && deltay == 0) { deltax=(DX-AX); deltay=(DY-AY); } - xo = mp_an_angle(mp,deltax,deltay); - - a = (bx-ax)*(cy-by) - (cx-bx)*(by-ay); /* a = (bp-ap)x(cp-bp); */ - b = (bx-ax)*(dy-cy) - (by-ay)*(dx-cx);; /* b = (bp-ap)x(dp-cp);*/ - c = (cx-bx)*(dy-cy) - (dx-cx)*(cy-by); /* c = (cp-bp)x(dp-cp);*/ - - if ((a==0)&&(c==0)) { - res = (b==0 ? 0 : (mp_out(xo)-mp_out(xi))); - } else if ((a==0)||(c==0)) { - if ((mp_sign(b) == mp_sign(a)) || (mp_sign(b) == mp_sign(c))) { - res = mp_out(xo)-mp_out(xi); /* ? */ - if (res<-180.0) - res += 360.0; - else if (res>180.0) - res -= 360.0; - } else { - res = mp_out(xo)-mp_out(xi); /* ? */ - } - } else if ((mp_sign(a)*mp_sign(c))<0) { - res = mp_out(xo)-mp_out(xi); /* ? */ - if (res<-180.0) - res += 360.0; - else if (res>180.0) - res -= 360.0; - } else { - if (mp_sign(a) == mp_sign(b)) { - res = mp_out(xo)-mp_out(xi); /* ? */ - if (res<-180.0) - res += 360.0; - else if (res>180.0) - res -= 360.0; - } else { - if ((b*b) == (4*a*c)) { - res = (double)bezier_error; - } else if ((b*b) < (4*a*c)) { - res = mp_out(xo)-mp_out(xi); /* ? */ - if (res<=0.0 &&res>-180.0) - res += 360.0; - else if (res>=0.0 && res<180.0) - res -= 360.0; - } else { - res = mp_out(xo)-mp_out(xi); - if (res<-180.0) - res += 360.0; - else if (res>180.0) - res -= 360.0; - } - } - } - return double2angle(res); -} - -@ -@d p_nextnext mp_link(mp_link(p)) -@d p_next mp_link(p) -@d seven_twenty_deg 05500000000 /* $720\cdot2^{20}$, represents $720^\circ$ */ - -@<Declare unary action...@>= -static scaled mp_new_turn_cycles (MP mp,pointer c) { - angle res,ang; /* the angles of intermediate results */ - scaled turns; /* the turn counter */ - pointer p; /* for running around the path */ - integer xp,yp; /* coordinates of next point */ - integer x,y; /* helper coordinates */ - angle in_angle,out_angle; /* helper angles */ - unsigned old_setting; /* saved |selector| setting */ - res=0; - turns= 0; - p=c; - old_setting = mp->selector; mp->selector=term_only; - if ( mp->internal[mp_tracing_commands]>unity ) { - mp_begin_diagnostic(mp); - mp_print_nl(mp, ""); - mp_end_diagnostic(mp, false); - } - do { - xp = mp_x_coord(p_next); yp = mp_y_coord(p_next); - ang = mp_bezier_slope(mp,mp_x_coord(p), mp_y_coord(p), mp_right_x(p), mp_right_y(p), - mp_left_x(p_next), mp_left_y(p_next), xp, yp); - if ( ang>seven_twenty_deg ) { - print_err("Strange path"); - mp_error(mp); - mp->selector=old_setting; - return 0; - } - res = res + ang; - if ( res > one_eighty_deg ) { - res = res - three_sixty_deg; - turns = turns + unity; - } - if ( res <= -one_eighty_deg ) { - res = res + three_sixty_deg; - turns = turns - unity; - } - /* incoming angle at next point */ - x = mp_left_x(p_next); y = mp_left_y(p_next); - if ( (xp==x)&&(yp==y) ) { x = mp_right_x(p); y = mp_right_y(p); }; - if ( (xp==x)&&(yp==y) ) { x = mp_x_coord(p); y = mp_y_coord(p); }; - in_angle = mp_an_angle(mp, xp - x, yp - y); - /* outgoing angle at next point */ - x = mp_right_x(p_next); y = mp_right_y(p_next); - if ( (xp==x)&&(yp==y) ) { x = mp_left_x(p_nextnext); y = mp_left_y(p_nextnext); }; - if ( (xp==x)&&(yp==y) ) { x = mp_x_coord(p_nextnext); y = mp_y_coord(p_nextnext); }; - out_angle = mp_an_angle(mp, x - xp, y- yp); - ang = (out_angle - in_angle); - reduce_angle(ang); - if ( ang!=0 ) { - res = res + ang; - if ( res >= one_eighty_deg ) { - res = res - three_sixty_deg; - turns = turns + unity; - }; - if ( res <= -one_eighty_deg ) { - res = res + three_sixty_deg; - turns = turns - unity; - }; - }; - p = mp_link(p); - } while (p!=c); - mp->selector=old_setting; - return turns; -} - - -@ This code is based on Bogus\l{}av Jackowski's -|emergency_turningnumber| macro, with some minor changes by Taco -Hoekwater. The macro code looked more like this: -{\obeylines -vardef turning\_number primary p = -~~save res, ang, turns; -~~res := 0; -~~if length p <= 2: -~~~~if Angle ((point 0 of p) - (postcontrol 0 of p)) >= 0: 1 else: -1 fi -~~else: -~~~~for t = 0 upto length p-1 : -~~~~~~angc := Angle ((point t+1 of p) - (point t of p)) -~~~~~~~~- Angle ((point t of p) - (point t-1 of p)); -~~~~~~if angc > 180: angc := angc - 360; fi; -~~~~~~if angc < -180: angc := angc + 360; fi; -~~~~~~res := res + angc; -~~~~endfor; -~~res/360 -~~fi -enddef;} -The general idea is to calculate only the sum of the angles of -straight lines between the points, of a path, not worrying about cusps -or self-intersections in the segments at all. If the segment is not -well-behaved, the result is not necesarily correct. But the old code -was not always correct either, and worse, it sometimes failed for -well-behaved paths as well. All known bugs that were triggered by the -original code no longer occur with this code, and it runs roughly 3 -times as fast because the algorithm is much simpler. - -@ It is possible to overflow the return value of the |turn_cycles| -function when the path is sufficiently long and winding, but I am not -going to bother testing for that. In any case, it would only return -the looped result value, which is not a big problem. - -The macro code for the repeat loop was a bit nicer to look -at than the pascal code, because it could use |point -1 of p|. In -pascal, the fastest way to loop around the path is not to look -backward once, but forward twice. These defines help hide the trick. - -@d p_to mp_link(mp_link(p)) -@d p_here mp_link(p) -@d p_from p - -@<Declare unary action...@>= -static scaled mp_turn_cycles (MP mp,pointer c) { - angle res,ang; /* the angles of intermediate results */ - scaled turns; /* the turn counter */ - pointer p; /* for running around the path */ - res=0; turns= 0; p=c; - do { - ang = mp_an_angle (mp, mp_x_coord(p_to) - mp_x_coord(p_here), - mp_y_coord(p_to) - mp_y_coord(p_here)) - - mp_an_angle (mp, mp_x_coord(p_here) - mp_x_coord(p_from), - mp_y_coord(p_here) - mp_y_coord(p_from)); - reduce_angle(ang); - res = res + ang; - if ( res >= three_sixty_deg ) { - res = res - three_sixty_deg; - turns = turns + unity; - }; - if ( res <= -three_sixty_deg ) { - res = res + three_sixty_deg; - turns = turns - unity; - }; - p = mp_link(p); - } while (p!=c); - return turns; -} - -@ @<Declare unary action...@>= -static scaled mp_turn_cycles_wrapper (MP mp,pointer c) { - scaled nval,oval; - scaled saved_t_o; /* tracing\_online saved */ - if ( (mp_link(c)==c)||(mp_link(mp_link(c))==c) ) { - if ( mp_an_angle (mp, mp_x_coord(c) - mp_right_x(c), mp_y_coord(c) - mp_right_y(c)) > 0 ) - return unity; - else - return -unity; - } else { - nval = mp_new_turn_cycles(mp, c); - oval = mp_turn_cycles(mp, c); - if ( nval!=oval ) { - saved_t_o=mp->internal[mp_tracing_online]; - mp->internal[mp_tracing_online]=unity; - mp_begin_diagnostic(mp); - mp_print_nl (mp, "Warning: the turningnumber algorithms do not agree." - " The current computed value is "); - mp_print_scaled(mp, nval); - mp_print(mp, ", but the 'connect-the-dots' algorithm returned "); - mp_print_scaled(mp, oval); - mp_end_diagnostic(mp, false); - mp->internal[mp_tracing_online]=saved_t_o; - } - return nval; - } -} - -@ @d type_range(A,B) { - if ( (mp->cur_type>=(A)) && (mp->cur_type<=(B)) ) - mp_flush_cur_exp(mp, true_code); - else mp_flush_cur_exp(mp, false_code); - mp->cur_type=mp_boolean_type; - } -@d type_test(A) { - if ( mp->cur_type==(A) ) mp_flush_cur_exp(mp, true_code); - else mp_flush_cur_exp(mp, false_code); - mp->cur_type=mp_boolean_type; - } - -@<Additional cases of unary operators@>= -case mp_boolean_type: - type_range(mp_boolean_type,mp_unknown_boolean); break; -case mp_string_type: - type_range(mp_string_type,mp_unknown_string); break; -case mp_pen_type: - type_range(mp_pen_type,mp_unknown_pen); break; -case mp_path_type: - type_range(mp_path_type,mp_unknown_path); break; -case mp_picture_type: - type_range(mp_picture_type,mp_unknown_picture); break; -case mp_transform_type: case mp_color_type: case mp_cmykcolor_type: -case mp_pair_type: - type_test(c); break; -case mp_numeric_type: - type_range(mp_known,mp_independent); break; -case known_op: case unknown_op: - mp_test_known(mp, c); break; - -@ @<Declare unary action procedures@>= -static void mp_test_known (MP mp,quarterword c) { - int b; /* is the current expression known? */ - pointer p,q; /* locations in a big node */ - b=false_code; - switch (mp->cur_type) { - case mp_vacuous: case mp_boolean_type: case mp_string_type: - case mp_pen_type: case mp_path_type: case mp_picture_type: - case mp_known: - b=true_code; - break; - case mp_transform_type: - case mp_color_type: case mp_cmykcolor_type: case mp_pair_type: - p=value(mp->cur_exp); - q=p+mp->big_node_size[mp->cur_type]; - do { - q=q-2; - if ( mp_type(q)!=mp_known ) - goto DONE; - } while (q!=p); - b=true_code; - DONE: - break; - default: - break; - } - if ( c==known_op ) mp_flush_cur_exp(mp, b); - else mp_flush_cur_exp(mp, true_code+false_code-b); - mp->cur_type=mp_boolean_type; -} - -@ @<Additional cases of unary operators@>= -case cycle_op: - if ( mp->cur_type!=mp_path_type ) mp_flush_cur_exp(mp, false_code); - else if ( mp_left_type(mp->cur_exp)!=mp_endpoint ) mp_flush_cur_exp(mp, true_code); - else mp_flush_cur_exp(mp, false_code); - mp->cur_type=mp_boolean_type; - break; - -@ @<Additional cases of unary operators@>= -case arc_length: - if ( mp->cur_type==mp_pair_type ) mp_pair_to_path(mp); - if ( mp->cur_type!=mp_path_type ) mp_bad_unary(mp, arc_length); - else mp_flush_cur_exp(mp, mp_get_arc_length(mp, mp->cur_exp)); - break; - -@ Here we use the fact that |c-filled_op+fill_code| is the desired graphical -object |type|. -@^data structure assumptions@> - -@<Additional cases of unary operators@>= -case filled_op: -case stroked_op: -case textual_op: -case clipped_op: -case bounded_op: - if ( mp->cur_type!=mp_picture_type ) mp_flush_cur_exp(mp, false_code); - else if ( mp_link(dummy_loc(mp->cur_exp))==null ) mp_flush_cur_exp(mp, false_code); - else if ( mp_type(mp_link(dummy_loc(mp->cur_exp)))==c+mp_fill_code-filled_op ) - mp_flush_cur_exp(mp, true_code); - else mp_flush_cur_exp(mp, false_code); - mp->cur_type=mp_boolean_type; - break; - -@ @<Additional cases of unary operators@>= -case make_pen_op: - if ( mp->cur_type==mp_pair_type ) mp_pair_to_path(mp); - if ( mp->cur_type!=mp_path_type ) mp_bad_unary(mp, make_pen_op); - else { - mp->cur_type=mp_pen_type; - mp->cur_exp=mp_make_pen(mp, mp->cur_exp,true); - }; - break; -case make_path_op: - if ( mp->cur_type!=mp_pen_type ) mp_bad_unary(mp, make_path_op); - else { - mp->cur_type=mp_path_type; - mp_make_path(mp, mp->cur_exp); - }; - break; -case reverse: - if ( mp->cur_type==mp_path_type ) { - p=mp_htap_ypoc(mp, mp->cur_exp); - if ( mp_right_type(p)==mp_endpoint ) p=mp_link(p); - mp_toss_knot_list(mp, mp->cur_exp); mp->cur_exp=p; - } else if ( mp->cur_type==mp_pair_type ) mp_pair_to_path(mp); - else mp_bad_unary(mp, reverse); - break; - -@ The |pair_value| routine changes the current expression to a -given ordered pair of values. - -@<Declare unary action procedures@>= -static void mp_pair_value (MP mp,scaled x, scaled y) { - pointer p; /* a pair node */ - p=mp_get_node(mp, value_node_size); - mp_flush_cur_exp(mp, p); mp->cur_type=mp_pair_type; - mp_type(p)=mp_pair_type; mp_name_type(p)=mp_capsule; mp_init_big_node(mp, p); - p=value(p); - mp_type(x_part_loc(p))=mp_known; value(x_part_loc(p))=x; - mp_type(y_part_loc(p))=mp_known; value(y_part_loc(p))=y; -} - -@ @<Additional cases of unary operators@>= -case ll_corner_op: - if ( ! mp_get_cur_bbox(mp) ) mp_bad_unary(mp, ll_corner_op); - else mp_pair_value(mp, mp_minx, mp_miny); - break; -case lr_corner_op: - if ( ! mp_get_cur_bbox(mp) ) mp_bad_unary(mp, lr_corner_op); - else mp_pair_value(mp, mp_maxx, mp_miny); - break; -case ul_corner_op: - if ( ! mp_get_cur_bbox(mp) ) mp_bad_unary(mp, ul_corner_op); - else mp_pair_value(mp, mp_minx, mp_maxy); - break; -case ur_corner_op: - if ( ! mp_get_cur_bbox(mp) ) mp_bad_unary(mp, ur_corner_op); - else mp_pair_value(mp, mp_maxx, mp_maxy); - break; - -@ Here is a function that sets |minx|, |maxx|, |miny|, |maxy| to the bounding -box of the current expression. The boolean result is |false| if the expression -has the wrong type. - -@<Declare unary action procedures@>= -static boolean mp_get_cur_bbox (MP mp) { - switch (mp->cur_type) { - case mp_picture_type: - mp_set_bbox(mp, mp->cur_exp,true); - if ( minx_val(mp->cur_exp)>maxx_val(mp->cur_exp) ) { - mp_minx=0; mp_maxx=0; mp_miny=0; mp_maxy=0; - } else { - mp_minx=minx_val(mp->cur_exp); - mp_maxx=maxx_val(mp->cur_exp); - mp_miny=miny_val(mp->cur_exp); - mp_maxy=maxy_val(mp->cur_exp); - } - break; - case mp_path_type: - mp_path_bbox(mp, mp->cur_exp); - break; - case mp_pen_type: - mp_pen_bbox(mp, mp->cur_exp); - break; - default: - return false; - } - return true; -} - -@ @<Additional cases of unary operators@>= -case read_from_op: -case close_from_op: - if ( mp->cur_type!=mp_string_type ) mp_bad_unary(mp, c); - else mp_do_read_or_close(mp,c); - break; - -@ Here is a routine that interprets |cur_exp| as a file name and tries to read -a line from the file or to close the file. - -@<Declare unary action procedures@>= -static void mp_do_read_or_close (MP mp,quarterword c) { - readf_index n,n0; /* indices for searching |rd_fname| */ - @<Find the |n| where |rd_fname[n]=cur_exp|; if |cur_exp| must be inserted, - call |start_read_input| and |goto found| or |not_found|@>; - mp_begin_file_reading(mp); - name=is_read; - if ( mp_input_ln(mp, mp->rd_file[n] ) ) - goto FOUND; - mp_end_file_reading(mp); -NOT_FOUND: - @<Record the end of file and set |cur_exp| to a dummy value@>; - return; -CLOSE_FILE: - mp_flush_cur_exp(mp, 0); mp->cur_type=mp_vacuous; - return; -FOUND: - mp_flush_cur_exp(mp, 0); - mp_finish_read(mp); -} - -@ Free slots in the |rd_file| and |rd_fname| arrays are marked with NULL's in -|rd_fname|. - -@<Find the |n| where |rd_fname[n]=cur_exp|...@>= -{ - char *fn; - n=mp->read_files; - n0=mp->read_files; - fn = str(mp->cur_exp); - while (mp_xstrcmp(fn,mp->rd_fname[n])!=0) { - if ( n>0 ) { - decr(n); - } else if ( c==close_from_op ) { - goto CLOSE_FILE; - } else { - if ( n0==mp->read_files ) { - if ( mp->read_files<mp->max_read_files ) { - incr(mp->read_files); - } else { - void **rd_file; - char **rd_fname; - readf_index l,k; - l = mp->max_read_files + (mp->max_read_files/4); - rd_file = xmalloc((l+1), sizeof(void *)); - rd_fname = xmalloc((l+1), sizeof(char *)); - for (k=0;k<=l;k++) { - if (k<=mp->max_read_files) { - rd_file[k]=mp->rd_file[k]; - rd_fname[k]=mp->rd_fname[k]; - } else { - rd_file[k]=0; - rd_fname[k]=NULL; - } - } - xfree(mp->rd_file); xfree(mp->rd_fname); - mp->max_read_files = l; - mp->rd_file = rd_file; - mp->rd_fname = rd_fname; - } - } - n=n0; - if ( mp_start_read_input(mp,fn,n) ) - goto FOUND; - else - goto NOT_FOUND; - } - if ( mp->rd_fname[n]==NULL ) { n0=n; } - } - if ( c==close_from_op ) { - (mp->close_file)(mp,mp->rd_file[n]); - goto NOT_FOUND; - } -} - -@ @<Record the end of file and set |cur_exp| to a dummy value@>= -xfree(mp->rd_fname[n]); -mp->rd_fname[n]=NULL; -if ( n==mp->read_files-1 ) mp->read_files=n; -if ( c==close_from_op ) - goto CLOSE_FILE; -mp_flush_cur_exp(mp, mp->eof_line); -mp->cur_type=mp_string_type - -@ The string denoting end-of-file is a one-byte string at position zero, by definition - -@<Glob...@>= -str_number eof_line; - -@ @<Set init...@>= -mp->eof_line=0; - -@ Finally, we have the operations that combine a capsule~|p| -with the current expression. - -@d binary_return { mp_finish_binary(mp, old_p, old_exp); return; } - -@c @<Declare binary action procedures@> -static void mp_finish_binary (MP mp, pointer old_p, pointer old_exp ){ - check_arith; - @<Recycle any sidestepped |independent| capsules@>; -} -static void mp_do_binary (MP mp,pointer p, quarterword c) { - pointer q,r,rr; /* for list manipulation */ - pointer old_p,old_exp; /* capsules to recycle */ - integer v; /* for numeric manipulation */ - check_arith; - if ( mp->internal[mp_tracing_commands]>two ) { - @<Trace the current binary operation@>; - } - @<Sidestep |independent| cases in capsule |p|@>; - @<Sidestep |independent| cases in the current expression@>; - switch (c) { - case plus: case minus: - @<Add or subtract the current expression from |p|@>; - break; - @<Additional cases of binary operators@>; - }; /* there are no other cases */ - mp_recycle_value(mp, p); - mp_free_node(mp, p,value_node_size); /* |return| to avoid this */ - mp_finish_binary(mp, old_p, old_exp); -} - -@ @<Declare binary action...@>= -static void mp_bad_binary (MP mp,pointer p, quarterword c) { - mp_disp_err(mp, p,""); - exp_err("Not implemented: "); -@.Not implemented...@> - if ( c>=min_of ) mp_print_op(mp, c); - mp_print_known_or_unknown_type(mp, mp_type(p),p); - if ( c>=min_of ) mp_print(mp, "of"); else mp_print_op(mp, c); - mp_print_known_or_unknown_type(mp, mp->cur_type,mp->cur_exp); - help3("I'm afraid I don't know how to apply that operation to that", - "combination of types. Continue, and I'll return the second", - "argument (see above) as the result of the operation."); - mp_put_get_error(mp); -} -static void mp_bad_envelope_pen (MP mp) { - mp_disp_err(mp, null,""); - exp_err("Not implemented: envelope(elliptical pen)of(path)"); -@.Not implemented...@> - help3("I'm afraid I don't know how to apply that operation to that", - "combination of types. Continue, and I'll return the second", - "argument (see above) as the result of the operation."); - mp_put_get_error(mp); -} - -@ @<Trace the current binary operation@>= -{ - mp_begin_diagnostic(mp); mp_print_nl(mp, "{("); - mp_print_exp(mp,p,0); /* show the operand, but not verbosely */ - mp_print_char(mp,xord(')')); mp_print_op(mp,c); mp_print_char(mp,xord('(')); - mp_print_exp(mp,null,0); mp_print(mp,")}"); - mp_end_diagnostic(mp, false); -} - -@ Several of the binary operations are potentially complicated by the -fact that |independent| values can sneak into capsules. For example, -we've seen an instance of this difficulty in the unary operation -of negation. In order to reduce the number of cases that need to be -handled, we first change the two operands (if necessary) -to rid them of |independent| components. The original operands are -put into capsules called |old_p| and |old_exp|, which will be -recycled after the binary operation has been safely carried out. - -@<Recycle any sidestepped |independent| capsules@>= -if ( old_p!=null ) { - mp_recycle_value(mp, old_p); mp_free_node(mp, old_p,value_node_size); -} -if ( old_exp!=null ) { - mp_recycle_value(mp, old_exp); mp_free_node(mp, old_exp,value_node_size); -} - -@ A big node is considered to be ``tarnished'' if it contains at least one -independent component. We will define a simple function called `|tarnished|' -that returns |null| if and only if its argument is not tarnished. - -@<Sidestep |independent| cases in capsule |p|@>= -switch (mp_type(p)) { -case mp_transform_type: -case mp_color_type: -case mp_cmykcolor_type: -case mp_pair_type: - old_p=mp_tarnished(mp, p); - break; -case mp_independent: old_p=mp_void; break; -default: old_p=null; break; -} -if ( old_p!=null ) { - q=mp_stash_cur_exp(mp); old_p=p; mp_make_exp_copy(mp, old_p); - p=mp_stash_cur_exp(mp); mp_unstash_cur_exp(mp, q); -} - -@ @<Sidestep |independent| cases in the current expression@>= -switch (mp->cur_type) { -case mp_transform_type: -case mp_color_type: -case mp_cmykcolor_type: -case mp_pair_type: - old_exp=mp_tarnished(mp, mp->cur_exp); - break; -case mp_independent:old_exp=mp_void; break; -default: old_exp=null; break; -} -if ( old_exp!=null ) { - old_exp=mp->cur_exp; mp_make_exp_copy(mp, old_exp); -} - -@ @<Declare binary action...@>= -static pointer mp_tarnished (MP mp,pointer p) { - pointer q; /* beginning of the big node */ - pointer r; /* current position in the big node */ - q=value(p); r=q+mp->big_node_size[mp_type(p)]; - do { - r=r-2; - if ( mp_type(r)==mp_independent ) return mp_void; - } while (r!=q); - return null; -} - -@ @<Add or subtract the current expression from |p|@>= -if ( (mp->cur_type<mp_color_type)||(mp_type(p)<mp_color_type) ) { - mp_bad_binary(mp, p,c); -} else { - if ((mp->cur_type>mp_pair_type)&&(mp_type(p)>mp_pair_type) ) { - mp_add_or_subtract(mp, p,null,c); - } else { - if ( mp->cur_type!=mp_type(p) ) { - mp_bad_binary(mp, p,c); - } else { - q=value(p); r=value(mp->cur_exp); - rr=r+mp->big_node_size[mp->cur_type]; - while ( r<rr ) { - mp_add_or_subtract(mp, q,r,c); - q=q+2; r=r+2; - } - } - } -} - -@ The first argument to |add_or_subtract| is the location of a value node -in a capsule or pair node that will soon be recycled. The second argument -is either a location within a pair or transform node of |cur_exp|, -or it is null (which means that |cur_exp| itself should be the second -argument). The third argument is either |plus| or |minus|. - -The sum or difference of the numeric quantities will replace the second -operand. Arithmetic overflow may go undetected; users aren't supposed to -be monkeying around with really big values. -@^overflow in arithmetic@> - -@<Declare binary action...@>= -@<Declare the procedure called |dep_finish|@> -static void mp_add_or_subtract (MP mp,pointer p, pointer q, quarterword c) { - quarterword s,t; /* operand types */ - pointer r; /* list traverser */ - integer v; /* second operand value */ - if ( q==null ) { - t=mp->cur_type; - if ( t<mp_dependent ) v=mp->cur_exp; else v=dep_list(mp->cur_exp); - } else { - t=mp_type(q); - if ( t<mp_dependent ) v=value(q); else v=dep_list(q); - } - if ( t==mp_known ) { - if ( c==minus ) negate(v); - if ( mp_type(p)==mp_known ) { - v=mp_slow_add(mp, value(p),v); - if ( q==null ) mp->cur_exp=v; else value(q)=v; - return; - } - @<Add a known value to the constant term of |dep_list(p)|@>; - } else { - if ( c==minus ) mp_negate_dep_list(mp, v); - @<Add operand |p| to the dependency list |v|@>; - } -} - -@ @<Add a known value to the constant term of |dep_list(p)|@>= -r=dep_list(p); -while ( mp_info(r)!=null ) r=mp_link(r); -value(r)=mp_slow_add(mp, value(r),v); -if ( q==null ) { - q=mp_get_node(mp, value_node_size); mp->cur_exp=q; mp->cur_type=mp_type(p); - mp_name_type(q)=mp_capsule; -} -dep_list(q)=dep_list(p); mp_type(q)=mp_type(p); -prev_dep(q)=prev_dep(p); mp_link(prev_dep(p))=q; -mp_type(p)=mp_known; /* this will keep the recycler from collecting non-garbage */ - -@ We prefer |dependent| lists to |mp_proto_dependent| ones, because it is -nice to retain the extra accuracy of |fraction| coefficients. -But we have to handle both kinds, and mixtures too. - -@<Add operand |p| to the dependency list |v|@>= -if ( mp_type(p)==mp_known ) { - @<Add the known |value(p)| to the constant term of |v|@>; -} else { - s=mp_type(p); r=dep_list(p); - if ( t==mp_dependent ) { - if ( s==mp_dependent ) { - if ( mp_max_coef(mp, r)+mp_max_coef(mp, v)<coef_bound ) { - v=mp_p_plus_q(mp, v,r,mp_dependent); goto DONE; - } - } /* |fix_needed| will necessarily be false */ - t=mp_proto_dependent; - v=mp_p_over_v(mp, v,unity,mp_dependent,mp_proto_dependent); - } - if ( s==mp_proto_dependent ) v=mp_p_plus_q(mp, v,r,mp_proto_dependent); - else v=mp_p_plus_fq(mp, v,unity,r,mp_proto_dependent,mp_dependent); - DONE: - @<Output the answer, |v| (which might have become |known|)@>; -} - -@ @<Add the known |value(p)| to the constant term of |v|@>= -{ - while ( mp_info(v)!=null ) v=mp_link(v); - value(v)=mp_slow_add(mp, value(p),value(v)); -} - -@ @<Output the answer, |v| (which might have become |known|)@>= -if ( q!=null ) mp_dep_finish(mp, v,q,t); -else { mp->cur_type=t; mp_dep_finish(mp, v,null,t); } - -@ Here's the current situation: The dependency list |v| of type |t| -should either be put into the current expression (if |q=null|) or -into location |q| within a pair node (otherwise). The destination (|cur_exp| -or |q|) formerly held a dependency list with the same -final pointer as the list |v|. - -@<Declare the procedure called |dep_finish|@>= -static void mp_dep_finish (MP mp, pointer v, pointer q, quarterword t) { - pointer p; /* the destination */ - scaled vv; /* the value, if it is |known| */ - if ( q==null ) p=mp->cur_exp; else p=q; - dep_list(p)=v; mp_type(p)=t; - if ( mp_info(v)==null ) { - vv=value(v); - if ( q==null ) { - mp_flush_cur_exp(mp, vv); - } else { - mp_recycle_value(mp, p); mp_type(q)=mp_known; value(q)=vv; - } - } else if ( q==null ) { - mp->cur_type=t; - } - if ( mp->fix_needed ) mp_fix_dependencies(mp); -} - -@ Let's turn now to the six basic relations of comparison. - -@<Additional cases of binary operators@>= -case less_than: case less_or_equal: case greater_than: -case greater_or_equal: case equal_to: case unequal_to: - check_arith; /* at this point |arith_error| should be |false|? */ - if ( (mp->cur_type>mp_pair_type)&&(mp_type(p)>mp_pair_type) ) { - mp_add_or_subtract(mp, p,null,minus); /* |cur_exp:=(p)-cur_exp| */ - } else if ( mp->cur_type!=mp_type(p) ) { - mp_bad_binary(mp, p,c); goto DONE; - } else if ( mp->cur_type==mp_string_type ) { - mp_flush_cur_exp(mp, mp_str_vs_str(mp, value(p),mp->cur_exp)); - } else if ((mp->cur_type==mp_unknown_string)|| - (mp->cur_type==mp_unknown_boolean) ) { - @<Check if unknowns have been equated@>; - } else if ( (mp->cur_type<=mp_pair_type)&&(mp->cur_type>=mp_transform_type)) { - @<Reduce comparison of big nodes to comparison of scalars@>; - } else if ( mp->cur_type==mp_boolean_type ) { - mp_flush_cur_exp(mp, mp->cur_exp-value(p)); - } else { - mp_bad_binary(mp, p,c); goto DONE; - } - @<Compare the current expression with zero@>; -DONE: - mp->arith_error=false; /* ignore overflow in comparisons */ - break; - -@ @<Compare the current expression with zero@>= -if ( mp->cur_type!=mp_known ) { - if ( mp->cur_type<mp_known ) { - mp_disp_err(mp, p,""); - help1("The quantities shown above have not been equated.") - } else { - help2("Oh dear. I can\'t decide if the expression above is positive,", - "negative, or zero. So this comparison test won't be `true'."); - } - exp_err("Unknown relation will be considered false"); -@.Unknown relation...@> - mp_put_get_flush_error(mp, false_code); -} else { - switch (c) { - case less_than: boolean_reset(mp->cur_exp<0); break; - case less_or_equal: boolean_reset(mp->cur_exp<=0); break; - case greater_than: boolean_reset(mp->cur_exp>0); break; - case greater_or_equal: boolean_reset(mp->cur_exp>=0); break; - case equal_to: boolean_reset(mp->cur_exp==0); break; - case unequal_to: boolean_reset(mp->cur_exp!=0); break; - }; /* there are no other cases */ -} -mp->cur_type=mp_boolean_type - -@ When two unknown strings are in the same ring, we know that they are -equal. Otherwise, we don't know whether they are equal or not, so we -make no change. - -@<Check if unknowns have been equated@>= -{ - q=value(mp->cur_exp); - while ( (q!=mp->cur_exp)&&(q!=p) ) q=value(q); - if ( q==p ) mp_flush_cur_exp(mp, 0); -} - -@ @<Reduce comparison of big nodes to comparison of scalars@>= -{ - q=value(p); r=value(mp->cur_exp); - rr=r+mp->big_node_size[mp->cur_type]-2; - while (1) { mp_add_or_subtract(mp, q,r,minus); - if ( mp_type(r)!=mp_known ) break; - if ( value(r)!=0 ) break; - if ( r==rr ) break; - q=q+2; r=r+2; - } - mp_take_part(mp, mp_name_type(r)+x_part-mp_x_part_sector); -} - -@ Here we use the sneaky fact that |and_op-false_code=or_op-true_code|. - -@<Additional cases of binary operators@>= -case and_op: -case or_op: - if ( (mp_type(p)!=mp_boolean_type)||(mp->cur_type!=mp_boolean_type) ) - mp_bad_binary(mp, p,c); - else if ( value(p)==c+false_code-and_op ) mp->cur_exp=value(p); - break; - -@ @<Additional cases of binary operators@>= -case times: - if ( (mp->cur_type<mp_color_type)||(mp_type(p)<mp_color_type) ) { - mp_bad_binary(mp, p,times); - } else if ( (mp->cur_type==mp_known)||(mp_type(p)==mp_known) ) { - @<Multiply when at least one operand is known@>; - } else if ( (mp_nice_color_or_pair(mp, p,mp_type(p))&&(mp->cur_type>mp_pair_type)) - ||(mp_nice_color_or_pair(mp, mp->cur_exp,mp->cur_type)&& - (mp_type(p)>mp_pair_type)) ) { - mp_hard_times(mp, p); - binary_return; - } else { - mp_bad_binary(mp, p,times); - } - break; - -@ @<Multiply when at least one operand is known@>= -{ - if ( mp_type(p)==mp_known ) { - v=value(p); mp_free_node(mp, p,value_node_size); - } else { - v=mp->cur_exp; mp_unstash_cur_exp(mp, p); - } - if ( mp->cur_type==mp_known ) { - mp->cur_exp=mp_take_scaled(mp, mp->cur_exp,v); - } else if ( (mp->cur_type==mp_pair_type)|| - (mp->cur_type==mp_color_type)|| - (mp->cur_type==mp_cmykcolor_type) ) { - p=value(mp->cur_exp)+mp->big_node_size[mp->cur_type]; - do { - p=p-2; mp_dep_mult(mp, p,v,true); - } while (p!=value(mp->cur_exp)); - } else { - mp_dep_mult(mp, null,v,true); - } - binary_return; -} - -@ @<Declare binary action...@>= -static void mp_dep_mult (MP mp,pointer p, integer v, boolean v_is_scaled) { - pointer q; /* the dependency list being multiplied by |v| */ - quarterword s,t; /* its type, before and after */ - if ( p==null ) { - q=mp->cur_exp; - } else if ( mp_type(p)!=mp_known ) { - q=p; - } else { - if ( v_is_scaled ) value(p)=mp_take_scaled(mp, value(p),v); - else value(p)=mp_take_fraction(mp, value(p),v); - return; - }; - t=mp_type(q); q=dep_list(q); s=t; - if ( t==mp_dependent ) if ( v_is_scaled ) - if (mp_ab_vs_cd(mp, mp_max_coef(mp,q),abs(v),coef_bound-1,unity)>=0 ) - t=mp_proto_dependent; - q=mp_p_times_v(mp, q,v,s,t,v_is_scaled); - mp_dep_finish(mp, q,p,t); -} - -@ Here is a routine that is similar to |times|; but it is invoked only -internally, when |v| is a |fraction| whose magnitude is at most~1, -and when |cur_type>=mp_color_type|. - -@c -static void mp_frac_mult (MP mp,scaled n, scaled d) { - /* multiplies |cur_exp| by |n/d| */ - pointer p; /* a pair node */ - pointer old_exp; /* a capsule to recycle */ - fraction v; /* |n/d| */ - if ( mp->internal[mp_tracing_commands]>two ) { - @<Trace the fraction multiplication@>; - } - switch (mp->cur_type) { - case mp_transform_type: - case mp_color_type: - case mp_cmykcolor_type: - case mp_pair_type: - old_exp=mp_tarnished(mp, mp->cur_exp); - break; - case mp_independent: old_exp=mp_void; break; - default: old_exp=null; break; - } - if ( old_exp!=null ) { - old_exp=mp->cur_exp; mp_make_exp_copy(mp, old_exp); - } - v=mp_make_fraction(mp, n,d); - if ( mp->cur_type==mp_known ) { - mp->cur_exp=mp_take_fraction(mp, mp->cur_exp,v); - } else if ( mp->cur_type<=mp_pair_type ) { - p=value(mp->cur_exp)+mp->big_node_size[mp->cur_type]; - do { - p=p-2; - mp_dep_mult(mp, p,v,false); - } while (p!=value(mp->cur_exp)); - } else { - mp_dep_mult(mp, null,v,false); - } - if ( old_exp!=null ) { - mp_recycle_value(mp, old_exp); - mp_free_node(mp, old_exp,value_node_size); - } -} - -@ @<Trace the fraction multiplication@>= -{ - mp_begin_diagnostic(mp); - mp_print_nl(mp, "{("); mp_print_scaled(mp,n); mp_print_char(mp,xord('/')); - mp_print_scaled(mp,d); mp_print(mp,")*("); mp_print_exp(mp,null,0); - mp_print(mp,")}"); - mp_end_diagnostic(mp, false); -} - -@ The |hard_times| routine multiplies a nice color or pair by a dependency list. - -@<Declare binary action procedures@>= -static void mp_hard_times (MP mp,pointer p) { - pointer q; /* a copy of the dependent variable |p| */ - pointer r; /* a component of the big node for the nice color or pair */ - scaled v; /* the known value for |r| */ - if ( mp_type(p)<=mp_pair_type ) { - q=mp_stash_cur_exp(mp); mp_unstash_cur_exp(mp, p); p=q; - }; /* now |cur_type=mp_pair_type| or |cur_type=mp_color_type| */ - r=value(mp->cur_exp)+mp->big_node_size[mp->cur_type]; - while (1) { - r=r-2; - v=value(r); - mp_type(r)=mp_type(p); - if ( r==value(mp->cur_exp) ) - break; - mp_new_dep(mp, r,mp_copy_dep_list(mp, dep_list(p))); - mp_dep_mult(mp, r,v,true); - } - mp->mem[value_loc(r)]=mp->mem[value_loc(p)]; - mp_link(prev_dep(p))=r; - mp_free_node(mp, p,value_node_size); - mp_dep_mult(mp, r,v,true); -} - -@ @<Additional cases of binary operators@>= -case over: - if ( (mp->cur_type!=mp_known)||(mp_type(p)<mp_color_type) ) { - mp_bad_binary(mp, p,over); - } else { - v=mp->cur_exp; mp_unstash_cur_exp(mp, p); - if ( v==0 ) { - @<Squeal about division by zero@>; - } else { - if ( mp->cur_type==mp_known ) { - mp->cur_exp=mp_make_scaled(mp, mp->cur_exp,v); - } else if ( mp->cur_type<=mp_pair_type ) { - p=value(mp->cur_exp)+mp->big_node_size[mp->cur_type]; - do { - p=p-2; mp_dep_div(mp, p,v); - } while (p!=value(mp->cur_exp)); - } else { - mp_dep_div(mp, null,v); - } - } - binary_return; - } - break; - -@ @<Declare binary action...@>= -static void mp_dep_div (MP mp,pointer p, scaled v) { - pointer q; /* the dependency list being divided by |v| */ - quarterword s,t; /* its type, before and after */ - if ( p==null ) q=mp->cur_exp; - else if ( mp_type(p)!=mp_known ) q=p; - else { value(p)=mp_make_scaled(mp, value(p),v); return; }; - t=mp_type(q); q=dep_list(q); s=t; - if ( t==mp_dependent ) - if ( mp_ab_vs_cd(mp, mp_max_coef(mp,q),unity,coef_bound-1,abs(v))>=0 ) - t=mp_proto_dependent; - q=mp_p_over_v(mp, q,v,s,t); - mp_dep_finish(mp, q,p,t); -} - -@ @<Squeal about division by zero@>= -{ - exp_err("Division by zero"); -@.Division by zero@> - help2("You're trying to divide the quantity shown above the error", - "message by zero. I'm going to divide it by one instead."); - mp_put_get_error(mp); -} - -@ @<Additional cases of binary operators@>= -case pythag_add: -case pythag_sub: - if ( (mp->cur_type==mp_known)&&(mp_type(p)==mp_known) ) { - if ( c==pythag_add ) mp->cur_exp=mp_pyth_add(mp, value(p),mp->cur_exp); - else mp->cur_exp=mp_pyth_sub(mp, value(p),mp->cur_exp); - } else mp_bad_binary(mp, p,c); - break; - -@ The next few sections of the program deal with affine transformations -of coordinate data. - -@<Additional cases of binary operators@>= -case rotated_by: case slanted_by: -case scaled_by: case shifted_by: case transformed_by: -case x_scaled: case y_scaled: case z_scaled: - if ( mp_type(p)==mp_path_type ) { - path_trans(c,p); binary_return; - } else if ( mp_type(p)==mp_pen_type ) { - pen_trans(c,p); - mp->cur_exp=mp_convex_hull(mp, mp->cur_exp); - /* rounding error could destroy convexity */ - binary_return; - } else if ( (mp_type(p)==mp_pair_type)||(mp_type(p)==mp_transform_type) ) { - mp_big_trans(mp, p,c); - } else if ( mp_type(p)==mp_picture_type ) { - mp_do_edges_trans(mp, p,c); binary_return; - } else { - mp_bad_binary(mp, p,c); - } - break; - -@ Let |c| be one of the eight transform operators. The procedure call -|set_up_trans(c)| first changes |cur_exp| to a transform that corresponds to -|c| and the original value of |cur_exp|. (In particular, |cur_exp| doesn't -change at all if |c=transformed_by|.) - -Then, if all components of the resulting transform are |known|, they are -moved to the global variables |txx|, |txy|, |tyx|, |tyy|, |tx|, |ty|; -and |cur_exp| is changed to the known value zero. - -@<Declare binary action...@>= -static void mp_set_up_trans (MP mp,quarterword c) { - pointer p,q,r; /* list manipulation registers */ - if ( (c!=transformed_by)||(mp->cur_type!=mp_transform_type) ) { - @<Put the current transform into |cur_exp|@>; - } - @<If the current transform is entirely known, stash it in global variables; - otherwise |return|@>; -} - -@ @<Glob...@>= -scaled txx; -scaled txy; -scaled tyx; -scaled tyy; -scaled tx; -scaled ty; /* current transform coefficients */ - -@ @<Put the current transform...@>= -{ - p=mp_stash_cur_exp(mp); - mp->cur_exp=mp_id_transform(mp); - mp->cur_type=mp_transform_type; - q=value(mp->cur_exp); - switch (c) { - @<For each of the eight cases, change the relevant fields of |cur_exp| - and |goto done|; - but do nothing if capsule |p| doesn't have the appropriate type@>; - }; /* there are no other cases */ - mp_disp_err(mp, p,"Improper transformation argument"); -@.Improper transformation argument@> - help3("The expression shown above has the wrong type,", - "so I can\'t transform anything using it.", - "Proceed, and I'll omit the transformation."); - mp_put_get_error(mp); -DONE: - mp_recycle_value(mp, p); - mp_free_node(mp, p,value_node_size); -} - -@ @<If the current transform is entirely known, ...@>= -q=value(mp->cur_exp); r=q+transform_node_size; -do { - r=r-2; - if ( mp_type(r)!=mp_known ) return; -} while (r!=q); -mp->txx=value(xx_part_loc(q)); -mp->txy=value(xy_part_loc(q)); -mp->tyx=value(yx_part_loc(q)); -mp->tyy=value(yy_part_loc(q)); -mp->tx=value(x_part_loc(q)); -mp->ty=value(y_part_loc(q)); -mp_flush_cur_exp(mp, 0) - -@ @<For each of the eight cases...@>= -case rotated_by: - if ( mp_type(p)==mp_known ) - @<Install sines and cosines, then |goto done|@>; - break; -case slanted_by: - if ( mp_type(p)>mp_pair_type ) { - mp_install(mp, xy_part_loc(q),p); goto DONE; - }; - break; -case scaled_by: - if ( mp_type(p)>mp_pair_type ) { - mp_install(mp, xx_part_loc(q),p); mp_install(mp, yy_part_loc(q),p); - goto DONE; - }; - break; -case shifted_by: - if ( mp_type(p)==mp_pair_type ) { - r=value(p); mp_install(mp, x_part_loc(q),x_part_loc(r)); - mp_install(mp, y_part_loc(q),y_part_loc(r)); goto DONE; - }; - break; -case x_scaled: - if ( mp_type(p)>mp_pair_type ) { - mp_install(mp, xx_part_loc(q),p); goto DONE; - }; - break; -case y_scaled: - if ( mp_type(p)>mp_pair_type ) { - mp_install(mp, yy_part_loc(q),p); goto DONE; - }; - break; -case z_scaled: - if ( mp_type(p)==mp_pair_type ) - @<Install a complex multiplier, then |goto done|@>; - break; -case transformed_by: - break; - - -@ @<Install sines and cosines, then |goto done|@>= -{ mp_n_sin_cos(mp, (value(p) % three_sixty_units)*16); - value(xx_part_loc(q))=mp_round_fraction(mp, mp->n_cos); - value(yx_part_loc(q))=mp_round_fraction(mp, mp->n_sin); - value(xy_part_loc(q))=-value(yx_part_loc(q)); - value(yy_part_loc(q))=value(xx_part_loc(q)); - goto DONE; -} - -@ @<Install a complex multiplier, then |goto done|@>= -{ - r=value(p); - mp_install(mp, xx_part_loc(q),x_part_loc(r)); - mp_install(mp, yy_part_loc(q),x_part_loc(r)); - mp_install(mp, yx_part_loc(q),y_part_loc(r)); - if ( mp_type(y_part_loc(r))==mp_known ) negate(value(y_part_loc(r))); - else mp_negate_dep_list(mp, dep_list(y_part_loc(r))); - mp_install(mp, xy_part_loc(q),y_part_loc(r)); - goto DONE; -} - -@ Procedure |set_up_known_trans| is like |set_up_trans|, but it -insists that the transformation be entirely known. - -@<Declare binary action...@>= -static void mp_set_up_known_trans (MP mp,quarterword c) { - mp_set_up_trans(mp, c); - if ( mp->cur_type!=mp_known ) { - exp_err("Transform components aren't all known"); -@.Transform components...@> - help3("I'm unable to apply a partially specified transformation", - "except to a fully known pair or transform.", - "Proceed, and I'll omit the transformation."); - mp_put_get_flush_error(mp, 0); - mp->txx=unity; mp->txy=0; mp->tyx=0; mp->tyy=unity; - mp->tx=0; mp->ty=0; - } -} - -@ Here's a procedure that applies the transform |txx..ty| to a pair of -coordinates in locations |p| and~|q|. - -@<Declare binary action...@>= -static void mp_trans (MP mp,pointer p, pointer q) { - scaled v; /* the new |x| value */ - v=mp_take_scaled(mp, mp->mem[p].sc,mp->txx)+ - mp_take_scaled(mp, mp->mem[q].sc,mp->txy)+mp->tx; - mp->mem[q].sc=mp_take_scaled(mp, mp->mem[p].sc,mp->tyx)+ - mp_take_scaled(mp, mp->mem[q].sc,mp->tyy)+mp->ty; - mp->mem[p].sc=v; -} - -@ The simplest transformation procedure applies a transform to all -coordinates of a path. The |path_trans(c)(p)| macro applies -a transformation defined by |cur_exp| and the transform operator |c| -to the path~|p|. - -@d path_trans(A,B) { mp_set_up_known_trans(mp, (A)); - mp_unstash_cur_exp(mp, (B)); - mp_do_path_trans(mp, mp->cur_exp); } - -@<Declare binary action...@>= -static void mp_do_path_trans (MP mp,pointer p) { - pointer q; /* list traverser */ - q=p; - do { - if ( mp_left_type(q)!=mp_endpoint ) - mp_trans(mp, q+3,q+4); /* that's |mp_left_x| and |mp_left_y| */ - mp_trans(mp, q+1,q+2); /* that's |mp_x_coord| and |mp_y_coord| */ - if ( mp_right_type(q)!=mp_endpoint ) - mp_trans(mp, q+5,q+6); /* that's |mp_right_x| and |mp_right_y| */ -@^data structure assumptions@> - q=mp_link(q); - } while (q!=p); -} - -@ Transforming a pen is very similar, except that there are no |mp_left_type| -and |mp_right_type| fields. - -@d pen_trans(A,B) { mp_set_up_known_trans(mp, (A)); - mp_unstash_cur_exp(mp, (B)); - mp_do_pen_trans(mp, mp->cur_exp); } - -@<Declare binary action...@>= -static void mp_do_pen_trans (MP mp,pointer p) { - pointer q; /* list traverser */ - if ( pen_is_elliptical(p) ) { - mp_trans(mp, p+3,p+4); /* that's |mp_left_x| and |mp_left_y| */ - mp_trans(mp, p+5,p+6); /* that's |mp_right_x| and |mp_right_y| */ - }; - q=p; - do { - mp_trans(mp, q+1,q+2); /* that's |mp_x_coord| and |mp_y_coord| */ -@^data structure assumptions@> - q=mp_link(q); - } while (q!=p); -} - -@ The next transformation procedure applies to edge structures. It will do -any transformation, but the results may be substandard if the picture contains -text that uses downloaded bitmap fonts. The binary action procedure is -|do_edges_trans|, but we also need a function that just scales a picture. -That routine is |scale_edges|. Both it and the underlying routine |edges_trans| -should be thought of as procedures that update an edge structure |h|, except -that they have to return a (possibly new) structure because of the need to call -|private_edges|. - -@<Declare binary action...@>= -static pointer mp_edges_trans (MP mp, pointer h) { - pointer q; /* the object being transformed */ - pointer r,s; /* for list manipulation */ - scaled sx,sy; /* saved transformation parameters */ - scaled sqdet; /* square root of determinant for |dash_scale| */ - integer sgndet; /* sign of the determinant */ - scaled v; /* a temporary value */ - h=mp_private_edges(mp, h); - sqdet=mp_sqrt_det(mp, mp->txx,mp->txy,mp->tyx,mp->tyy); - sgndet=mp_ab_vs_cd(mp, mp->txx,mp->tyy,mp->txy,mp->tyx); - if ( dash_list(h)!=null_dash ) { - @<Try to transform the dash list of |h|@>; - } - @<Make the bounding box of |h| unknown if it can't be updated properly - without scanning the whole structure@>; - q=mp_link(dummy_loc(h)); - while ( q!=null ) { - @<Transform graphical object |q|@>; - q=mp_link(q); - } - return h; -} -static void mp_do_edges_trans (MP mp,pointer p, quarterword c) { - mp_set_up_known_trans(mp, c); - value(p)=mp_edges_trans(mp, value(p)); - mp_unstash_cur_exp(mp, p); -} -static void mp_scale_edges (MP mp) { - mp->txx=mp->se_sf; mp->tyy=mp->se_sf; - mp->txy=0; mp->tyx=0; mp->tx=0; mp->ty=0; - mp->se_pic=mp_edges_trans(mp, mp->se_pic); -} - -@ @<Try to transform the dash list of |h|@>= -if ( (mp->txy!=0)||(mp->tyx!=0)|| - (mp->ty!=0)||(abs(mp->txx)!=abs(mp->tyy))) { - mp_flush_dash_list(mp, h); -} else { - if ( mp->txx<0 ) { @<Reverse the dash list of |h|@>; } - @<Scale the dash list by |txx| and shift it by |tx|@>; - dash_y(h)=mp_take_scaled(mp, dash_y(h),abs(mp->tyy)); -} - -@ @<Reverse the dash list of |h|@>= -{ - r=dash_list(h); - dash_list(h)=null_dash; - while ( r!=null_dash ) { - s=r; r=mp_link(r); - v=start_x(s); start_x(s)=stop_x(s); stop_x(s)=v; - mp_link(s)=dash_list(h); - dash_list(h)=s; - } -} - -@ @<Scale the dash list by |txx| and shift it by |tx|@>= -r=dash_list(h); -while ( r!=null_dash ) { - start_x(r)=mp_take_scaled(mp, start_x(r),mp->txx)+mp->tx; - stop_x(r)=mp_take_scaled(mp, stop_x(r),mp->txx)+mp->tx; - r=mp_link(r); -} - -@ @<Make the bounding box of |h| unknown if it can't be updated properly...@>= -if ( (mp->txx==0)&&(mp->tyy==0) ) { - @<Swap the $x$ and $y$ parameters in the bounding box of |h|@>; -} else if ( (mp->txy!=0)||(mp->tyx!=0) ) { - mp_init_bbox(mp, h); - goto DONE1; -} -if ( minx_val(h)<=maxx_val(h) ) { - @<Scale the bounding box by |txx+txy| and |tyx+tyy|; then shift by - |(tx,ty)|@>; -} -DONE1: - - - -@ @<Swap the $x$ and $y$ parameters in the bounding box of |h|@>= -{ - v=minx_val(h); minx_val(h)=miny_val(h); miny_val(h)=v; - v=maxx_val(h); maxx_val(h)=maxy_val(h); maxy_val(h)=v; -} - -@ The sum ``|txx+txy|'' is whichever of |txx| or |txy| is nonzero. The other -sum is similar. - -@<Scale the bounding box by |txx+txy| and |tyx+tyy|; then shift...@>= -{ - minx_val(h)=mp_take_scaled(mp, minx_val(h),mp->txx+mp->txy)+mp->tx; - maxx_val(h)=mp_take_scaled(mp, maxx_val(h),mp->txx+mp->txy)+mp->tx; - miny_val(h)=mp_take_scaled(mp, miny_val(h),mp->tyx+mp->tyy)+mp->ty; - maxy_val(h)=mp_take_scaled(mp, maxy_val(h),mp->tyx+mp->tyy)+mp->ty; - if ( mp->txx+mp->txy<0 ) { - v=minx_val(h); minx_val(h)=maxx_val(h); maxx_val(h)=v; - } - if ( mp->tyx+mp->tyy<0 ) { - v=miny_val(h); miny_val(h)=maxy_val(h); maxy_val(h)=v; - } -} - -@ Now we ready for the main task of transforming the graphical objects in edge -structure~|h|. - -@<Transform graphical object |q|@>= -switch (mp_type(q)) { -case mp_fill_code: case mp_stroked_code: - mp_do_path_trans(mp, mp_path_p(q)); - @<Transform |mp_pen_p(q)|, making sure polygonal pens stay counter-clockwise@>; - break; -case mp_start_clip_code: case mp_start_bounds_code: - mp_do_path_trans(mp, mp_path_p(q)); - break; -case mp_text_code: - r=text_tx_loc(q); - @<Transform the compact transformation starting at |r|@>; - break; -case mp_stop_clip_code: case mp_stop_bounds_code: - break; -} /* there are no other cases */ - -@ Note that the shift parameters |(tx,ty)| apply only to the path being stroked. -The |dash_scale| has to be adjusted to scale the dash lengths in |mp_dash_p(q)| -since the \ps\ output procedures will try to compensate for the transformation -we are applying to |mp_pen_p(q)|. Since this compensation is based on the square -root of the determinant, |sqdet| is the appropriate factor. - -@<Transform |mp_pen_p(q)|, making sure...@>= -if ( mp_pen_p(q)!=null ) { - sx=mp->tx; sy=mp->ty; - mp->tx=0; mp->ty=0; - mp_do_pen_trans(mp, mp_pen_p(q)); - if ( ((mp_type(q)==mp_stroked_code)&&(mp_dash_p(q)!=null)) ) - dash_scale(q)=mp_take_scaled(mp, dash_scale(q),sqdet); - if ( ! pen_is_elliptical(mp_pen_p(q)) ) - if ( sgndet<0 ) - mp_pen_p(q)=mp_make_pen(mp, mp_copy_path(mp, mp_pen_p(q)),true); - /* this unreverses the pen */ - mp->tx=sx; mp->ty=sy; -} - -@ This uses the fact that transformations are stored in the order -|(tx,ty,txx,txy,tyx,tyy)|. -@^data structure assumptions@> - -@<Transform the compact transformation starting at |r|@>= -mp_trans(mp, r,r+1); -sx=mp->tx; sy=mp->ty; -mp->tx=0; mp->ty=0; -mp_trans(mp, r+2,r+4); -mp_trans(mp, r+3,r+5); -mp->tx=sx; mp->ty=sy - -@ The hard cases of transformation occur when big nodes are involved, -and when some of their components are unknown. - -@<Declare binary action...@>= -@<Declare subroutines needed by |big_trans|@> -static void mp_big_trans (MP mp,pointer p, quarterword c) { - pointer q,r,pp,qq; /* list manipulation registers */ - quarterword s; /* size of a big node */ - s=mp->big_node_size[mp_type(p)]; q=value(p); r=q+s; - do { - r=r-2; - if ( mp_type(r)!=mp_known ) { - @<Transform an unknown big node and |return|@>; - } - } while (r!=q); - @<Transform a known big node@>; -} /* node |p| will now be recycled by |do_binary| */ - -@ @<Transform an unknown big node and |return|@>= -{ - mp_set_up_known_trans(mp, c); mp_make_exp_copy(mp, p); - r=value(mp->cur_exp); - if ( mp->cur_type==mp_transform_type ) { - mp_bilin1(mp, yy_part_loc(r),mp->tyy,xy_part_loc(q),mp->tyx,0); - mp_bilin1(mp, yx_part_loc(r),mp->tyy,xx_part_loc(q),mp->tyx,0); - mp_bilin1(mp, xy_part_loc(r),mp->txx,yy_part_loc(q),mp->txy,0); - mp_bilin1(mp, xx_part_loc(r),mp->txx,yx_part_loc(q),mp->txy,0); - } - mp_bilin1(mp, y_part_loc(r),mp->tyy,x_part_loc(q),mp->tyx,mp->ty); - mp_bilin1(mp, x_part_loc(r),mp->txx,y_part_loc(q),mp->txy,mp->tx); - return; -} - -@ Let |p| point to a two-word value field inside a big node of |cur_exp|, -and let |q| point to a another value field. The |bilin1| procedure -replaces |p| by $p\cdot t+q\cdot u+\delta$. - -@<Declare subroutines needed by |big_trans|@>= -static void mp_bilin1 (MP mp, pointer p, scaled t, pointer q, - scaled u, scaled delta) { - pointer r; /* list traverser */ - if ( t!=unity ) mp_dep_mult(mp, p,t,true); - if ( u!=0 ) { - if ( mp_type(q)==mp_known ) { - delta+=mp_take_scaled(mp, value(q),u); - } else { - @<Ensure that |type(p)=mp_proto_dependent|@>; - dep_list(p)=mp_p_plus_fq(mp, dep_list(p),u,dep_list(q), - mp_proto_dependent,mp_type(q)); - } - } - if ( mp_type(p)==mp_known ) { - value(p)+=delta; - } else { - r=dep_list(p); - while ( mp_info(r)!=null ) r=mp_link(r); - delta+=value(r); - if ( r!=dep_list(p) ) value(r)=delta; - else { mp_recycle_value(mp, p); mp_type(p)=mp_known; value(p)=delta; }; - } - if ( mp->fix_needed ) mp_fix_dependencies(mp); -} - -@ @<Ensure that |type(p)=mp_proto_dependent|@>= -if ( mp_type(p)!=mp_proto_dependent ) { - if ( mp_type(p)==mp_known ) - mp_new_dep(mp, p,mp_const_dependency(mp, value(p))); - else - dep_list(p)=mp_p_times_v(mp, dep_list(p),unity,mp_dependent, - mp_proto_dependent,true); - mp_type(p)=mp_proto_dependent; -} - -@ @<Transform a known big node@>= -mp_set_up_trans(mp, c); -if ( mp->cur_type==mp_known ) { - @<Transform known by known@>; -} else { - pp=mp_stash_cur_exp(mp); qq=value(pp); - mp_make_exp_copy(mp, p); r=value(mp->cur_exp); - if ( mp->cur_type==mp_transform_type ) { - mp_bilin2(mp, yy_part_loc(r),yy_part_loc(qq), - value(xy_part_loc(q)),yx_part_loc(qq),null); - mp_bilin2(mp, yx_part_loc(r),yy_part_loc(qq), - value(xx_part_loc(q)),yx_part_loc(qq),null); - mp_bilin2(mp, xy_part_loc(r),xx_part_loc(qq), - value(yy_part_loc(q)),xy_part_loc(qq),null); - mp_bilin2(mp, xx_part_loc(r),xx_part_loc(qq), - value(yx_part_loc(q)),xy_part_loc(qq),null); - }; - mp_bilin2(mp, y_part_loc(r),yy_part_loc(qq), - value(x_part_loc(q)),yx_part_loc(qq),y_part_loc(qq)); - mp_bilin2(mp, x_part_loc(r),xx_part_loc(qq), - value(y_part_loc(q)),xy_part_loc(qq),x_part_loc(qq)); - mp_recycle_value(mp, pp); mp_free_node(mp, pp,value_node_size); -} - -@ Let |p| be a |mp_proto_dependent| value whose dependency list ends -at |dep_final|. The following procedure adds |v| times another -numeric quantity to~|p|. - -@<Declare subroutines needed by |big_trans|@>= -static void mp_add_mult_dep (MP mp,pointer p, scaled v, pointer r) { - if ( mp_type(r)==mp_known ) { - value(mp->dep_final)+=mp_take_scaled(mp, value(r),v); - } else { - dep_list(p)=mp_p_plus_fq(mp, dep_list(p),v,dep_list(r), - mp_proto_dependent,mp_type(r)); - if ( mp->fix_needed ) mp_fix_dependencies(mp); - } -} - -@ The |bilin2| procedure is something like |bilin1|, but with known -and unknown quantities reversed. Parameter |p| points to a value field -within the big node for |cur_exp|; and |type(p)=mp_known|. Parameters -|t| and~|u| point to value fields elsewhere; so does parameter~|q|, -unless it is |null| (which stands for zero). Location~|p| will be -replaced by $p\cdot t+v\cdot u+q$. - -@<Declare subroutines needed by |big_trans|@>= -static void mp_bilin2 (MP mp,pointer p, pointer t, scaled v, - pointer u, pointer q) { - scaled vv; /* temporary storage for |value(p)| */ - vv=value(p); mp_type(p)=mp_proto_dependent; - mp_new_dep(mp, p,mp_const_dependency(mp, 0)); /* this sets |dep_final| */ - if ( vv!=0 ) - mp_add_mult_dep(mp, p,vv,t); /* |dep_final| doesn't change */ - if ( v!=0 ) mp_add_mult_dep(mp, p,v,u); - if ( q!=null ) mp_add_mult_dep(mp, p,unity,q); - if ( dep_list(p)==mp->dep_final ) { - vv=value(mp->dep_final); mp_recycle_value(mp, p); - mp_type(p)=mp_known; value(p)=vv; - } -} - -@ @<Transform known by known@>= -{ - mp_make_exp_copy(mp, p); r=value(mp->cur_exp); - if ( mp->cur_type==mp_transform_type ) { - mp_bilin3(mp, yy_part_loc(r),mp->tyy,value(xy_part_loc(q)),mp->tyx,0); - mp_bilin3(mp, yx_part_loc(r),mp->tyy,value(xx_part_loc(q)),mp->tyx,0); - mp_bilin3(mp, xy_part_loc(r),mp->txx,value(yy_part_loc(q)),mp->txy,0); - mp_bilin3(mp, xx_part_loc(r),mp->txx,value(yx_part_loc(q)),mp->txy,0); - } - mp_bilin3(mp, y_part_loc(r),mp->tyy,value(x_part_loc(q)),mp->tyx,mp->ty); - mp_bilin3(mp, x_part_loc(r),mp->txx,value(y_part_loc(q)),mp->txy,mp->tx); -} - -@ Finally, in |bilin3| everything is |known|. - -@<Declare subroutines needed by |big_trans|@>= -static void mp_bilin3 (MP mp,pointer p, scaled t, - scaled v, scaled u, scaled delta) { - if ( t!=unity ) - delta+=mp_take_scaled(mp, value(p),t); - else - delta+=value(p); - if ( u!=0 ) value(p)=delta+mp_take_scaled(mp, v,u); - else value(p)=delta; -} - -@ @<Additional cases of binary operators@>= -case concatenate: - if ( (mp->cur_type==mp_string_type)&&(mp_type(p)==mp_string_type) ) mp_cat(mp, p); - else mp_bad_binary(mp, p,concatenate); - break; -case substring_of: - if ( mp_nice_pair(mp, p,mp_type(p))&&(mp->cur_type==mp_string_type) ) - mp_chop_string(mp, value(p)); - else mp_bad_binary(mp, p,substring_of); - break; -case subpath_of: - if ( mp->cur_type==mp_pair_type ) mp_pair_to_path(mp); - if ( mp_nice_pair(mp, p,mp_type(p))&&(mp->cur_type==mp_path_type) ) - mp_chop_path(mp, value(p)); - else mp_bad_binary(mp, p,subpath_of); - break; - -@ @<Declare binary action...@>= -static void mp_cat (MP mp,pointer p) { - str_number a,b; /* the strings being concatenated */ - integer k; /* run length */ - integer needed; - a=value(p); b=mp->cur_exp; k=length(a); - needed=mp->pool_ptr+k+length(b); - /* this will free some memory, hopefully */ - if (mp->pool_ptr>(11*mp->old_pool_size)/10) { - mp->old_pool_size = mp->pool_ptr; - mp_do_compaction(mp, mp->pool_size); - } - if ( needed > mp->max_pool_ptr ) { - if ( needed > mp->pool_size ) { - mp_reallocate_pool(mp,needed); - } - mp->max_pool_ptr=needed; - } - memcpy(mp->str_pool+mp->pool_ptr, mp->str_pool+mp->str_start[a],(size_t)k); - mp->pool_ptr+=k; - k=length(b); - memcpy(mp->str_pool+mp->pool_ptr, mp->str_pool+mp->str_start[b],(size_t)k); - mp->pool_ptr+=k; - mp->cur_exp=mp_make_string(mp); delete_str_ref(b); -} - -@ @<Declare binary action...@>= -static void mp_chop_string (MP mp,pointer p) { - integer a, b; /* start and stop points */ - integer l; /* length of the original string */ - integer k; /* runs from |a| to |b| */ - str_number s; /* the original string */ - boolean reversed; /* was |a>b|? */ - a=mp_round_unscaled(mp, value(x_part_loc(p))); - b=mp_round_unscaled(mp, value(y_part_loc(p))); - if ( a<=b ) reversed=false; - else { reversed=true; k=a; a=b; b=k; }; - s=mp->cur_exp; l=length(s); - if ( a<0 ) { - a=0; - if ( b<0 ) b=0; - } - if ( b>l ) { - b=l; - if ( a>l ) a=l; - } - str_room(b-a); - if ( reversed ) { - for (k=mp->str_start[s]+b-1;k>=mp->str_start[s]+a;k--) { - append_char(mp->str_pool[k]); - } - } else { - for (k=mp->str_start[s]+a;k<mp->str_start[s]+b;k++) { - append_char(mp->str_pool[k]); - } - } - mp->cur_exp=mp_make_string(mp); delete_str_ref(s); -} - -@ @<Declare binary action...@>= -static void mp_chop_path (MP mp,pointer p) { - pointer q; /* a knot in the original path */ - pointer pp,qq,rr,ss; /* link variables for copies of path nodes */ - scaled a,b,k,l; /* indices for chopping */ - boolean reversed; /* was |a>b|? */ - l=mp_path_length(mp); a=value(x_part_loc(p)); b=value(y_part_loc(p)); - if ( a<=b ) reversed=false; - else { reversed=true; k=a; a=b; b=k; }; - @<Dispense with the cases |a<0| and/or |b>l|@>; - q=mp->cur_exp; - while ( a>=unity ) { - q=mp_link(q); a=a-unity; b=b-unity; - } - if ( b==a ) { - @<Construct a path from |pp| to |qq| of length zero@>; - } else { - @<Construct a path from |pp| to |qq| of length $\lceil b\rceil$@>; - } - mp_left_type(pp)=mp_endpoint; mp_right_type(qq)=mp_endpoint; mp_link(qq)=pp; - mp_toss_knot_list(mp, mp->cur_exp); - if ( reversed ) { - mp->cur_exp=mp_link(mp_htap_ypoc(mp, pp)); mp_toss_knot_list(mp, pp); - } else { - mp->cur_exp=pp; - } -} - -@ @<Dispense with the cases |a<0| and/or |b>l|@>= -if ( a<0 ) { - if ( mp_left_type(mp->cur_exp)==mp_endpoint ) { - a=0; if ( b<0 ) b=0; - } else { - do { a=a+l; b=b+l; } while (a<0); /* a cycle always has length |l>0| */ - } -} -if ( b>l ) { - if ( mp_left_type(mp->cur_exp)==mp_endpoint ) { - b=l; if ( a>l ) a=l; - } else { - while ( a>=l ) { - a=a-l; b=b-l; - } - } -} - -@ @<Construct a path from |pp| to |qq| of length $\lceil b\rceil$@>= -{ - pp=mp_copy_knot(mp, q); qq=pp; - do { - q=mp_link(q); rr=qq; qq=mp_copy_knot(mp, q); mp_link(rr)=qq; b=b-unity; - } while (b>0); - if ( a>0 ) { - ss=pp; pp=mp_link(pp); - mp_split_cubic(mp, ss,a*010000); pp=mp_link(ss); - mp_free_node(mp, ss,knot_node_size); - if ( rr==ss ) { - b=mp_make_scaled(mp, b,unity-a); rr=pp; - } - } - if ( b<0 ) { - mp_split_cubic(mp, rr,(b+unity)*010000); - mp_free_node(mp, qq,knot_node_size); - qq=mp_link(rr); - } -} - -@ @<Construct a path from |pp| to |qq| of length zero@>= -{ - if ( a>0 ) { mp_split_cubic(mp, q,a*010000); q=mp_link(q); }; - pp=mp_copy_knot(mp, q); qq=pp; -} - -@ @<Additional cases of binary operators@>= -case point_of: case precontrol_of: case postcontrol_of: - if ( mp->cur_type==mp_pair_type ) - mp_pair_to_path(mp); - if ( (mp->cur_type==mp_path_type)&&(mp_type(p)==mp_known) ) - mp_find_point(mp, value(p),c); - else - mp_bad_binary(mp, p,c); - break; -case pen_offset_of: - if ( (mp->cur_type==mp_pen_type)&& mp_nice_pair(mp, p,mp_type(p)) ) - mp_set_up_offset(mp, value(p)); - else - mp_bad_binary(mp, p,pen_offset_of); - break; -case direction_time_of: - if ( mp->cur_type==mp_pair_type ) mp_pair_to_path(mp); - if ( (mp->cur_type==mp_path_type)&& mp_nice_pair(mp, p,mp_type(p)) ) - mp_set_up_direction_time(mp, value(p)); - else - mp_bad_binary(mp, p,direction_time_of); - break; -case envelope_of: - if ( (mp_type(p) != mp_pen_type) || (mp->cur_type != mp_path_type) ) - mp_bad_binary(mp, p,envelope_of); - else - mp_set_up_envelope(mp, p); - break; - -@ @<Declare binary action...@>= -static void mp_set_up_offset (MP mp,pointer p) { - mp_find_offset(mp, value(x_part_loc(p)),value(y_part_loc(p)),mp->cur_exp); - mp_pair_value(mp, mp->cur_x,mp->cur_y); -} -static void mp_set_up_direction_time (MP mp,pointer p) { - mp_flush_cur_exp(mp, mp_find_direction_time(mp, value(x_part_loc(p)), - value(y_part_loc(p)),mp->cur_exp)); -} -static void mp_set_up_envelope (MP mp,pointer p) { - quarterword ljoin, lcap; - scaled miterlim; - pointer q = mp_copy_path(mp, mp->cur_exp); /* the original path */ - /* TODO: accept elliptical pens for straight paths */ - if (pen_is_elliptical(value(p))) { - mp_bad_envelope_pen(mp); - mp->cur_exp = q; - mp->cur_type = mp_path_type; - return; - } - if ( mp->internal[mp_linejoin]>unity ) ljoin=2; - else if ( mp->internal[mp_linejoin]>0 ) ljoin=1; - else ljoin=0; - if ( mp->internal[mp_linecap]>unity ) lcap=2; - else if ( mp->internal[mp_linecap]>0 ) lcap=1; - else lcap=0; - if ( mp->internal[mp_miterlimit]<unity ) - miterlim=unity; - else - miterlim=mp->internal[mp_miterlimit]; - mp->cur_exp = mp_make_envelope(mp, q, value(p), ljoin,lcap,miterlim); - mp->cur_type = mp_path_type; -} - -@ @<Declare binary action...@>= -static void mp_find_point (MP mp,scaled v, quarterword c) { - pointer p; /* the path */ - scaled n; /* its length */ - p=mp->cur_exp; - if ( mp_left_type(p)==mp_endpoint ) n=-unity; else n=0; - do { p=mp_link(p); n=n+unity; } while (p!=mp->cur_exp); - if ( n==0 ) { - v=0; - } else if ( v<0 ) { - if ( mp_left_type(p)==mp_endpoint ) v=0; - else v=n-1-((-v-1) % n); - } else if ( v>n ) { - if ( mp_left_type(p)==mp_endpoint ) v=n; - else v=v % n; - } - p=mp->cur_exp; - while ( v>=unity ) { p=mp_link(p); v=v-unity; }; - if ( v!=0 ) { - @<Insert a fractional node by splitting the cubic@>; - } - @<Set the current expression to the desired path coordinates@>; -} - -@ @<Insert a fractional node...@>= -{ mp_split_cubic(mp, p,v*010000); p=mp_link(p); } - -@ @<Set the current expression to the desired path coordinates...@>= -switch (c) { -case point_of: - mp_pair_value(mp, mp_x_coord(p),mp_y_coord(p)); - break; -case precontrol_of: - if ( mp_left_type(p)==mp_endpoint ) mp_pair_value(mp, mp_x_coord(p),mp_y_coord(p)); - else mp_pair_value(mp, mp_left_x(p),mp_left_y(p)); - break; -case postcontrol_of: - if ( mp_right_type(p)==mp_endpoint ) mp_pair_value(mp, mp_x_coord(p),mp_y_coord(p)); - else mp_pair_value(mp, mp_right_x(p),mp_right_y(p)); - break; -} /* there are no other cases */ - -@ @<Additional cases of binary operators@>= -case arc_time_of: - if ( mp->cur_type==mp_pair_type ) - mp_pair_to_path(mp); - if ( (mp->cur_type==mp_path_type)&&(mp_type(p)==mp_known) ) - mp_flush_cur_exp(mp, mp_get_arc_time(mp, mp->cur_exp,value(p))); - else - mp_bad_binary(mp, p,c); - break; - -@ @<Additional cases of bin...@>= -case intersect: - if ( mp_type(p)==mp_pair_type ) { - q=mp_stash_cur_exp(mp); mp_unstash_cur_exp(mp, p); - mp_pair_to_path(mp); p=mp_stash_cur_exp(mp); mp_unstash_cur_exp(mp, q); - }; - if ( mp->cur_type==mp_pair_type ) mp_pair_to_path(mp); - if ( (mp->cur_type==mp_path_type)&&(mp_type(p)==mp_path_type) ) { - mp_path_intersection(mp, value(p),mp->cur_exp); - mp_pair_value(mp, mp->cur_t,mp->cur_tt); - } else { - mp_bad_binary(mp, p,intersect); - } - break; - -@ @<Additional cases of bin...@>= -case in_font: - if ( (mp->cur_type!=mp_string_type)||(mp_type(p)!=mp_string_type)) - mp_bad_binary(mp, p,in_font); - else { mp_do_infont(mp, p); binary_return; } - break; - -@ Function |new_text_node| owns the reference count for its second argument -(the text string) but not its first (the font name). - -@<Declare binary action...@>= -static void mp_do_infont (MP mp,pointer p) { - pointer q; - q=mp_get_node(mp, edge_header_size); - mp_init_edges(mp, q); - mp_link(obj_tail(q))=mp_new_text_node(mp,str(mp->cur_exp),value(p)); - obj_tail(q)=mp_link(obj_tail(q)); - mp_free_node(mp, p,value_node_size); - mp_flush_cur_exp(mp, q); - mp->cur_type=mp_picture_type; -} - -@* \[40] Statements and commands. -The chief executive of \MP\ is the |do_statement| routine, which -contains the master switch that causes all the various pieces of \MP\ -to do their things, in the right order. - -In a sense, this is the grand climax of the program: It applies all the -tools that we have worked so hard to construct. In another sense, this is -the messiest part of the program: It necessarily refers to other pieces -of code all over the place, so that a person can't fully understand what is -going on without paging back and forth to be reminded of conventions that -are defined elsewhere. We are now at the hub of the web. - -The structure of |do_statement| itself is quite simple. The first token -of the statement is fetched using |get_x_next|. If it can be the first -token of an expression, we look for an equation, an assignment, or a -title. Otherwise we use a \&{case} construction to branch at high speed to -the appropriate routine for various and sundry other types of commands, -each of which has an ``action procedure'' that does the necessary work. - -The program uses the fact that -$$\hbox{|min_primary_command=max_statement_command=type_name|}$$ -to interpret a statement that starts with, e.g., `\&{string}', -as a type declaration rather than a boolean expression. - -@c void mp_do_statement (MP mp) { /* governs \MP's activities */ - mp->cur_type=mp_vacuous; mp_get_x_next(mp); - if ( mp->cur_cmd>max_primary_command ) { - @<Worry about bad statement@>; - } else if ( mp->cur_cmd>max_statement_command ) { - @<Do an equation, assignment, title, or - `$\langle\,$expression$\,\rangle\,$\&{endgroup}'@>; - } else { - @<Do a statement that doesn't begin with an expression@>; - } - if ( mp->cur_cmd<semicolon ) - @<Flush unparsable junk that was found after the statement@>; - mp->error_count=0; -} - -@ @<Declarations@>= -@<Declare action procedures for use by |do_statement|@> - -@ The only command codes |>max_primary_command| that can be present -at the beginning of a statement are |semicolon| and higher; these -occur when the statement is null. - -@<Worry about bad statement@>= -{ - if ( mp->cur_cmd<semicolon ) { - print_err("A statement can't begin with `"); -@.A statement can't begin with x@> - mp_print_cmd_mod(mp, mp->cur_cmd,mp->cur_mod); mp_print_char(mp, xord('\'')); - help5("I was looking for the beginning of a new statement.", - "If you just proceed without changing anything, I'll ignore", - "everything up to the next `;'. Please insert a semicolon", - "now in front of anything that you don't want me to delete.", - "(See Chapter 27 of The METAFONTbook for an example.)"); -@:METAFONTbook}{\sl The {\logos METAFONT\/}book@> - mp_back_error(mp); mp_get_x_next(mp); - } -} - -@ The help message printed here says that everything is flushed up to -a semicolon, but actually the commands |end_group| and |stop| will -also terminate a statement. - -@<Flush unparsable junk that was found after the statement@>= -{ - print_err("Extra tokens will be flushed"); -@.Extra tokens will be flushed@> - help6("I've just read as much of that statement as I could fathom,", - "so a semicolon should have been next. It's very puzzling...", - "but I'll try to get myself back together, by ignoring", - "everything up to the next `;'. Please insert a semicolon", - "now in front of anything that you don't want me to delete.", - "(See Chapter 27 of The METAFONTbook for an example.)"); -@:METAFONTbook}{\sl The {\logos METAFONT\/}book@> - mp_back_error(mp); mp->scanner_status=flushing; - do { - get_t_next; - @<Decrease the string reference count...@>; - } while (! end_of_statement); /* |cur_cmd=semicolon|, |end_group|, or |stop| */ - mp->scanner_status=normal; -} - -@ If |do_statement| ends with |cur_cmd=end_group|, we should have -|cur_type=mp_vacuous| unless the statement was simply an expression; -in the latter case, |cur_type| and |cur_exp| should represent that -expression. - -@<Do a statement that doesn't...@>= -{ - if ( mp->internal[mp_tracing_commands]>0 ) - show_cur_cmd_mod; - switch (mp->cur_cmd ) { - case type_name:mp_do_type_declaration(mp); break; - case macro_def: - if ( mp->cur_mod>var_def ) mp_make_op_def(mp); - else if ( mp->cur_mod>end_def ) mp_scan_def(mp); - break; - @<Cases of |do_statement| that invoke particular commands@>; - } /* there are no other cases */ - mp->cur_type=mp_vacuous; -} - -@ The most important statements begin with expressions. - -@<Do an equation, assignment, title, or...@>= -{ - mp->var_flag=assignment; mp_scan_expression(mp); - if ( mp->cur_cmd<end_group ) { - if ( mp->cur_cmd==equals ) mp_do_equation(mp); - else if ( mp->cur_cmd==assignment ) mp_do_assignment(mp); - else if ( mp->cur_type==mp_string_type ) {@<Do a title@> ; } - else if ( mp->cur_type!=mp_vacuous ){ - exp_err("Isolated expression"); -@.Isolated expression@> - help3("I couldn't find an `=' or `:=' after the", - "expression that is shown above this error message,", - "so I guess I'll just ignore it and carry on."); - mp_put_get_error(mp); - } - mp_flush_cur_exp(mp, 0); mp->cur_type=mp_vacuous; - } -} - -@ @<Do a title@>= -{ - if ( mp->internal[mp_tracing_titles]>0 ) { - mp_print_nl(mp, ""); mp_print_str(mp, mp->cur_exp); update_terminal; - } -} - -@ Equations and assignments are performed by the pair of mutually recursive -@^recursion@> -routines |do_equation| and |do_assignment|. These routines are called when -|cur_cmd=equals| and when |cur_cmd=assignment|, respectively; the left-hand -side is in |cur_type| and |cur_exp|, while the right-hand side is yet -to be scanned. After the routines are finished, |cur_type| and |cur_exp| -will be equal to the right-hand side (which will normally be equal -to the left-hand side). - -@<Declarations@>= -@<Declare the procedure called |make_eq|@> -static void mp_do_equation (MP mp) ; - -@ @c -void mp_do_equation (MP mp) { - pointer lhs; /* capsule for the left-hand side */ - pointer p; /* temporary register */ - lhs=mp_stash_cur_exp(mp); mp_get_x_next(mp); - mp->var_flag=assignment; mp_scan_expression(mp); - if ( mp->cur_cmd==equals ) mp_do_equation(mp); - else if ( mp->cur_cmd==assignment ) mp_do_assignment(mp); - if ( mp->internal[mp_tracing_commands]>two ) - @<Trace the current equation@>; - if ( mp->cur_type==mp_unknown_path ) if ( mp_type(lhs)==mp_pair_type ) { - p=mp_stash_cur_exp(mp); mp_unstash_cur_exp(mp, lhs); lhs=p; - }; /* in this case |make_eq| will change the pair to a path */ - mp_make_eq(mp, lhs); /* equate |lhs| to |(cur_type,cur_exp)| */ -} - -@ And |do_assignment| is similar to |do_equation|: - -@<Declarations@>= -static void mp_do_assignment (MP mp); - -@ @c -void mp_do_assignment (MP mp) { - pointer lhs; /* token list for the left-hand side */ - pointer p; /* where the left-hand value is stored */ - pointer q; /* temporary capsule for the right-hand value */ - if ( mp->cur_type!=mp_token_list ) { - exp_err("Improper `:=' will be changed to `='"); -@.Improper `:='@> - help2("I didn't find a variable name at the left of the `:=',", - "so I'm going to pretend that you said `=' instead."); - mp_error(mp); mp_do_equation(mp); - } else { - lhs=mp->cur_exp; mp->cur_type=mp_vacuous; - mp_get_x_next(mp); mp->var_flag=assignment; mp_scan_expression(mp); - if ( mp->cur_cmd==equals ) mp_do_equation(mp); - else if ( mp->cur_cmd==assignment ) mp_do_assignment(mp); - if ( mp->internal[mp_tracing_commands]>two ) - @<Trace the current assignment@>; - if ( mp_info(lhs)>hash_end ) { - @<Assign the current expression to an internal variable@>; - } else { - @<Assign the current expression to the variable |lhs|@>; - } - mp_flush_node_list(mp, lhs); - } -} - -@ @<Trace the current equation@>= -{ - mp_begin_diagnostic(mp); mp_print_nl(mp, "{("); mp_print_exp(mp,lhs,0); - mp_print(mp,")=("); mp_print_exp(mp,null,0); - mp_print(mp,")}"); mp_end_diagnostic(mp, false); -} - -@ @<Trace the current assignment@>= -{ - mp_begin_diagnostic(mp); mp_print_nl(mp, "{"); - if ( mp_info(lhs)>hash_end ) - mp_print(mp, mp->int_name[mp_info(lhs)-(hash_end)]); - else - mp_show_token_list(mp, lhs,null,1000,0); - mp_print(mp, ":="); mp_print_exp(mp, null,0); - mp_print_char(mp, xord('}')); mp_end_diagnostic(mp, false); -} - -@ @<Assign the current expression to an internal variable@>= -if ( mp->cur_type==mp_known ) { - mp->internal[mp_info(lhs)-(hash_end)]=mp->cur_exp; -} else { - exp_err("Internal quantity `"); -@.Internal quantity...@> - mp_print(mp, mp->int_name[mp_info(lhs)-(hash_end)]); - mp_print(mp, "' must receive a known value"); - help2("I can\'t set an internal quantity to anything but a known", - "numeric value, so I'll have to ignore this assignment."); - mp_put_get_error(mp); -} - -@ @<Assign the current expression to the variable |lhs|@>= -{ - p=mp_find_variable(mp, lhs); - if ( p!=null ) { - q=mp_stash_cur_exp(mp); mp->cur_type=mp_und_type(mp, p); - mp_recycle_value(mp, p); - mp_type(p)=mp->cur_type; value(p)=null; mp_make_exp_copy(mp, p); - p=mp_stash_cur_exp(mp); mp_unstash_cur_exp(mp, q); mp_make_eq(mp, p); - } else { - mp_obliterated(mp, lhs); mp_put_get_error(mp); - } -} - - -@ And now we get to the nitty-gritty. The |make_eq| procedure is given -a pointer to a capsule that is to be equated to the current expression. - -@<Declare the procedure called |make_eq|@>= -static void mp_make_eq (MP mp,pointer lhs) ; - - -@ -@c void mp_make_eq (MP mp,pointer lhs) { - quarterword t; /* type of the left-hand side */ - pointer p,q; /* pointers inside of big nodes */ - integer v=0; /* value of the left-hand side */ -RESTART: - t=mp_type(lhs); - if ( t<=mp_pair_type ) v=value(lhs); - switch (t) { - @<For each type |t|, make an equation and |goto done| unless |cur_type| - is incompatible with~|t|@>; - } /* all cases have been listed */ - @<Announce that the equation cannot be performed@>; -DONE: - check_arith; mp_recycle_value(mp, lhs); - mp_free_node(mp, lhs,value_node_size); -} - -@ @<Announce that the equation cannot be performed@>= -mp_disp_err(mp, lhs,""); -exp_err("Equation cannot be performed ("); -@.Equation cannot be performed@> -if ( mp_type(lhs)<=mp_pair_type ) mp_print_type(mp, mp_type(lhs)); -else mp_print(mp, "numeric"); -mp_print_char(mp, xord('=')); -if ( mp->cur_type<=mp_pair_type ) mp_print_type(mp, mp->cur_type); -else mp_print(mp, "numeric"); -mp_print_char(mp, xord(')')); -help2("I'm sorry, but I don't know how to make such things equal.", - "(See the two expressions just above the error message.)"); -mp_put_get_error(mp) - -@ @<For each type |t|, make an equation and |goto done| unless...@>= -case mp_boolean_type: case mp_string_type: case mp_pen_type: -case mp_path_type: case mp_picture_type: - if ( mp->cur_type==t+unknown_tag ) { - mp_nonlinear_eq(mp, v,mp->cur_exp,false); - mp_unstash_cur_exp(mp, mp->cur_exp); goto DONE; - } else if ( mp->cur_type==t ) { - @<Report redundant or inconsistent equation and |goto done|@>; - } - break; -case unknown_types: - if ( mp->cur_type==t-unknown_tag ) { - mp_nonlinear_eq(mp, mp->cur_exp,lhs,true); goto DONE; - } else if ( mp->cur_type==t ) { - mp_ring_merge(mp, lhs,mp->cur_exp); goto DONE; - } else if ( mp->cur_type==mp_pair_type ) { - if ( t==mp_unknown_path ) { - mp_pair_to_path(mp); goto RESTART; - }; - } - break; -case mp_transform_type: case mp_color_type: -case mp_cmykcolor_type: case mp_pair_type: - if ( mp->cur_type==t ) { - @<Do multiple equations and |goto done|@>; - } - break; -case mp_known: case mp_dependent: -case mp_proto_dependent: case mp_independent: - if ( mp->cur_type>=mp_known ) { - mp_try_eq(mp, lhs,null); goto DONE; - }; - break; -case mp_vacuous: - break; - -@ @<Report redundant or inconsistent equation and |goto done|@>= -{ - if ( mp->cur_type<=mp_string_type ) { - if ( mp->cur_type==mp_string_type ) { - if ( mp_str_vs_str(mp, v,mp->cur_exp)!=0 ) { - goto NOT_FOUND; - } - } else if ( v!=mp->cur_exp ) { - goto NOT_FOUND; - } - @<Exclaim about a redundant equation@>; goto DONE; - } - print_err("Redundant or inconsistent equation"); -@.Redundant or inconsistent equation@> - help2("An equation between already-known quantities can't help.", - "But don't worry; continue and I'll just ignore it."); - mp_put_get_error(mp); goto DONE; -NOT_FOUND: - print_err("Inconsistent equation"); -@.Inconsistent equation@> - help2("The equation I just read contradicts what was said before.", - "But don't worry; continue and I'll just ignore it."); - mp_put_get_error(mp); goto DONE; -} - -@ @<Do multiple equations and |goto done|@>= -{ - p=v+mp->big_node_size[t]; - q=value(mp->cur_exp)+mp->big_node_size[t]; - do { - p=p-2; q=q-2; mp_try_eq(mp, p,q); - } while (p!=v); - goto DONE; -} - -@ The first argument to |try_eq| is the location of a value node -in a capsule that will soon be recycled. The second argument is -either a location within a pair or transform node pointed to by -|cur_exp|, or it is |null| (which means that |cur_exp| itself -serves as the second argument). The idea is to leave |cur_exp| unchanged, -but to equate the two operands. - -@<Declarations@>= -static void mp_try_eq (MP mp,pointer l, pointer r) ; - -@ -@c void mp_try_eq (MP mp,pointer l, pointer r) { - pointer p; /* dependency list for right operand minus left operand */ - int t; /* the type of list |p| */ - pointer q; /* the constant term of |p| is here */ - pointer pp; /* dependency list for right operand */ - int tt; /* the type of list |pp| */ - boolean copied; /* have we copied a list that ought to be recycled? */ - @<Remove the left operand from its container, negate it, and - put it into dependency list~|p| with constant term~|q|@>; - @<Add the right operand to list |p|@>; - if ( mp_info(p)==null ) { - @<Deal with redundant or inconsistent equation@>; - } else { - mp_linear_eq(mp, p,t); - if ( r==null ) if ( mp->cur_type!=mp_known ) { - if ( mp_type(mp->cur_exp)==mp_known ) { - pp=mp->cur_exp; mp->cur_exp=value(mp->cur_exp); mp->cur_type=mp_known; - mp_free_node(mp, pp,value_node_size); - } - } - } -} - -@ @<Remove the left operand from its container, negate it, and...@>= -t=mp_type(l); -if ( t==mp_known ) { - t=mp_dependent; p=mp_const_dependency(mp, -value(l)); q=p; -} else if ( t==mp_independent ) { - t=mp_dependent; p=mp_single_dependency(mp, l); negate(value(p)); - q=mp->dep_final; -} else { - p=dep_list(l); q=p; - while (1) { - negate(value(q)); - if ( mp_info(q)==null ) break; - q=mp_link(q); - } - mp_link(prev_dep(l))=mp_link(q); prev_dep(mp_link(q))=prev_dep(l); - mp_type(l)=mp_known; -} - -@ @<Deal with redundant or inconsistent equation@>= -{ - if ( abs(value(p))>64 ) { /* off by .001 or more */ - print_err("Inconsistent equation"); -@.Inconsistent equation@> - mp_print(mp, " (off by "); mp_print_scaled(mp, value(p)); - mp_print_char(mp, xord(')')); - help2("The equation I just read contradicts what was said before.", - "But don't worry; continue and I'll just ignore it."); - mp_put_get_error(mp); - } else if ( r==null ) { - @<Exclaim about a redundant equation@>; - } - mp_free_node(mp, p,dep_node_size); -} - -@ @<Add the right operand to list |p|@>= -if ( r==null ) { - if ( mp->cur_type==mp_known ) { - value(q)=value(q)+mp->cur_exp; goto DONE1; - } else { - tt=mp->cur_type; - if ( tt==mp_independent ) pp=mp_single_dependency(mp, mp->cur_exp); - else pp=dep_list(mp->cur_exp); - } -} else { - if ( mp_type(r)==mp_known ) { - value(q)=value(q)+value(r); goto DONE1; - } else { - tt=mp_type(r); - if ( tt==mp_independent ) pp=mp_single_dependency(mp, r); - else pp=dep_list(r); - } -} -if ( tt!=mp_independent ) copied=false; -else { copied=true; tt=mp_dependent; }; -@<Add dependency list |pp| of type |tt| to dependency list~|p| of type~|t|@>; -if ( copied ) mp_flush_node_list(mp, pp); -DONE1: - -@ @<Add dependency list |pp| of type |tt| to dependency list~|p| of type~|t|@>= -mp->watch_coefs=false; -if ( t==tt ) { - p=mp_p_plus_q(mp, p,pp,t); -} else if ( t==mp_proto_dependent ) { - p=mp_p_plus_fq(mp, p,unity,pp,mp_proto_dependent,mp_dependent); -} else { - q=p; - while ( mp_info(q)!=null ) { - value(q)=mp_round_fraction(mp, value(q)); q=mp_link(q); - } - t=mp_proto_dependent; p=mp_p_plus_q(mp, p,pp,t); -} -mp->watch_coefs=true; - -@ Our next goal is to process type declarations. For this purpose it's -convenient to have a procedure that scans a $\langle\,$declared -variable$\,\rangle$ and returns the corresponding token list. After the -following procedure has acted, the token after the declared variable -will have been scanned, so it will appear in |cur_cmd|, |cur_mod|, -and~|cur_sym|. - -@<Declarations@>= -static pointer mp_scan_declared_variable (MP mp) ; - -@ @c -pointer mp_scan_declared_variable (MP mp) { - pointer x; /* hash address of the variable's root */ - pointer h,t; /* head and tail of the token list to be returned */ - pointer l; /* hash address of left bracket */ - mp_get_symbol(mp); x=mp->cur_sym; - if ( mp->cur_cmd!=tag_token ) mp_clear_symbol(mp, x,false); - h=mp_get_avail(mp); mp_info(h)=x; t=h; - while (1) { - mp_get_x_next(mp); - if ( mp->cur_sym==0 ) break; - if ( mp->cur_cmd!=tag_token ) if ( mp->cur_cmd!=internal_quantity) { - if ( mp->cur_cmd==left_bracket ) { - @<Descend past a collective subscript@>; - } else { - break; - } - } - mp_link(t)=mp_get_avail(mp); t=mp_link(t); mp_info(t)=mp->cur_sym; - } - if ( (eq_type(x)%outer_tag)!=tag_token ) mp_clear_symbol(mp, x,false); - if ( equiv(x)==null ) mp_new_root(mp, x); - return h; -} - -@ If the subscript isn't collective, we don't accept it as part of the -declared variable. - -@<Descend past a collective subscript@>= -{ - l=mp->cur_sym; mp_get_x_next(mp); - if ( mp->cur_cmd!=right_bracket ) { - mp_back_input(mp); mp->cur_sym=l; mp->cur_cmd=left_bracket; break; - } else { - mp->cur_sym=collective_subscript; - } -} - -@ Type declarations are introduced by the following primitive operations. - -@<Put each...@>= -mp_primitive(mp, "numeric",type_name,mp_numeric_type); -@:numeric_}{\&{numeric} primitive@> -mp_primitive(mp, "string",type_name,mp_string_type); -@:string_}{\&{string} primitive@> -mp_primitive(mp, "boolean",type_name,mp_boolean_type); -@:boolean_}{\&{boolean} primitive@> -mp_primitive(mp, "path",type_name,mp_path_type); -@:path_}{\&{path} primitive@> -mp_primitive(mp, "pen",type_name,mp_pen_type); -@:pen_}{\&{pen} primitive@> -mp_primitive(mp, "picture",type_name,mp_picture_type); -@:picture_}{\&{picture} primitive@> -mp_primitive(mp, "transform",type_name,mp_transform_type); -@:transform_}{\&{transform} primitive@> -mp_primitive(mp, "color",type_name,mp_color_type); -@:color_}{\&{color} primitive@> -mp_primitive(mp, "rgbcolor",type_name,mp_color_type); -@:color_}{\&{rgbcolor} primitive@> -mp_primitive(mp, "cmykcolor",type_name,mp_cmykcolor_type); -@:color_}{\&{cmykcolor} primitive@> -mp_primitive(mp, "pair",type_name,mp_pair_type); -@:pair_}{\&{pair} primitive@> - -@ @<Cases of |print_cmd...@>= -case type_name: mp_print_type(mp, m); break; - -@ Now we are ready to handle type declarations, assuming that a -|type_name| has just been scanned. - -@<Declare action procedures for use by |do_statement|@>= -static void mp_do_type_declaration (MP mp) ; - -@ @c -void mp_do_type_declaration (MP mp) { - quarterword t; /* the type being declared */ - pointer p; /* token list for a declared variable */ - pointer q; /* value node for the variable */ - if ( mp->cur_mod>=mp_transform_type ) - t=mp->cur_mod; - else - t=mp->cur_mod+unknown_tag; - do { - p=mp_scan_declared_variable(mp); - mp_flush_variable(mp, equiv(mp_info(p)),mp_link(p),false); - q=mp_find_variable(mp, p); - if ( q!=null ) { - mp_type(q)=t; value(q)=null; - } else { - print_err("Declared variable conflicts with previous vardef"); -@.Declared variable conflicts...@> - help2("You can't use, e.g., `numeric foo[]' after `vardef foo'.", - "Proceed, and I'll ignore the illegal redeclaration."); - mp_put_get_error(mp); - } - mp_flush_list(mp, p); - if ( mp->cur_cmd<comma ) { - @<Flush spurious symbols after the declared variable@>; - } - } while (! end_of_statement); -} - -@ @<Flush spurious symbols after the declared variable@>= -{ - print_err("Illegal suffix of declared variable will be flushed"); -@.Illegal suffix...flushed@> - help5("Variables in declarations must consist entirely of", - "names and collective subscripts, e.g., `x[]a'.", - "Are you trying to use a reserved word in a variable name?", - "I'm going to discard the junk I found here,", - "up to the next comma or the end of the declaration."); - if ( mp->cur_cmd==numeric_token ) - mp->help_line[2]="Explicit subscripts like `x15a' aren't permitted."; - mp_put_get_error(mp); mp->scanner_status=flushing; - do { - get_t_next; - @<Decrease the string reference count...@>; - } while (mp->cur_cmd<comma); /* either |end_of_statement| or |cur_cmd=comma| */ - mp->scanner_status=normal; -} - -@ \MP's |main_control| procedure just calls |do_statement| repeatedly -until coming to the end of the user's program. -Each execution of |do_statement| concludes with -|cur_cmd=semicolon|, |end_group|, or |stop|. - -@c -static void mp_main_control (MP mp) { - do { - mp_do_statement(mp); - if ( mp->cur_cmd==end_group ) { - print_err("Extra `endgroup'"); -@.Extra `endgroup'@> - help2("I'm not currently working on a `begingroup',", - "so I had better not try to end anything."); - mp_flush_error(mp, 0); - } - } while (mp->cur_cmd!=stop); -} -int mp_run (MP mp) { - if (mp->history < mp_fatal_error_stop ) { - xfree(mp->jump_buf); - mp->jump_buf = malloc(sizeof(jmp_buf)); - if (mp->jump_buf == NULL || setjmp(*(mp->jump_buf)) != 0) - return mp->history; - mp_main_control(mp); /* come to life */ - mp_final_cleanup(mp); /* prepare for death */ - mp_close_files_and_terminate(mp); - } - return mp->history; -} - -@ For |mp_execute|, we need to define a structure to store the -redirected input and output. This structure holds the five relevant -streams: the three informational output streams, the PostScript -generation stream, and the input stream. These streams have many -things in common, so it makes sense to give them their own structure -definition. - -\item{fptr} is a virtual file pointer -\item{data} is the data this stream holds -\item{cur} is a cursor pointing into |data| -\item{size} is the allocated length of the data stream -\item{used} is the actual length of the data stream - -There are small differences between input and output: |term_in| never -uses |used|, whereas the other four never use |cur|. - -@<Exported types@>= -typedef struct { - void * fptr; - char * data; - char * cur; - size_t size; - size_t used; -} mp_stream; - -typedef struct { - mp_stream term_out; - mp_stream error_out; - mp_stream log_out; - mp_stream ps_out; - mp_stream term_in; - struct mp_edge_object *edges; -} mp_run_data; - -@ We need a function to clear an output stream, this is called at the -beginning of |mp_execute|. We also need one for destroying an output -stream, this is called just before a stream is (re)opened. - -@c -static void mp_reset_stream(mp_stream *str) { - xfree(str->data); - str->cur = NULL; - str->size = 0; - str->used = 0; -} -static void mp_free_stream(mp_stream *str) { - xfree(str->fptr); - mp_reset_stream(str); -} - -@ @<Declarations@>= -static void mp_reset_stream(mp_stream *str); -static void mp_free_stream(mp_stream *str); - -@ The global instance contains a pointer instead of the actual structure -even though it is essentially static, because that makes it is easier to move -the object around. - -@<Global ...@>= -mp_run_data run_data; - -@ Another type is needed: the indirection will overload some of the -file pointer objects in the instance (but not all). For clarity, an -indirect object is used that wraps a |FILE *|. - -@<Types ... @>= -typedef struct File { - FILE *f; -} File; - -@ Here are all of the functions that need to be overloaded for |mp_execute|. - -@<Declarations@>= -static void *mplib_open_file(MP mp, const char *fname, const char *fmode, int ftype); -static int mplib_get_char(void *f, mp_run_data * mplib_data); -static void mplib_unget_char(void *f, mp_run_data * mplib_data, int c); -static char *mplib_read_ascii_file(MP mp, void *ff, size_t * size); -static void mplib_write_ascii_file(MP mp, void *ff, const char *s); -static void mplib_read_binary_file(MP mp, void *ff, void **data, size_t * size); -static void mplib_write_binary_file(MP mp, void *ff, void *s, size_t size); -static void mplib_close_file(MP mp, void *ff); -static int mplib_eof_file(MP mp, void *ff); -static void mplib_flush_file(MP mp, void *ff); -static void mplib_shipout_backend(MP mp, int h); - -@ The |xmalloc(1,1)| calls make sure the stored indirection values are unique. - -@d reset_stream(a) do { - mp_reset_stream(&(a)); - if (!ff->f) { - ff->f = xmalloc(1,1); - (a).fptr = ff->f; - } } while (0) - -@c - -static void *mplib_open_file(MP mp, const char *fname, const char *fmode, int ftype) -{ - File *ff = xmalloc(1, sizeof(File)); - mp_run_data *run = mp_rundata(mp); - ff->f = NULL; - if (ftype == mp_filetype_terminal) { - if (fmode[0] == 'r') { - if (!ff->f) { - ff->f = xmalloc(1,1); - run->term_in.fptr = ff->f; - } - } else { - reset_stream(run->term_out); - } - } else if (ftype == mp_filetype_error) { - reset_stream(run->error_out); - } else if (ftype == mp_filetype_log) { - reset_stream(run->log_out); - } else if (ftype == mp_filetype_postscript) { - mp_free_stream(&(run->ps_out)); - ff->f = xmalloc(1,1); - run->ps_out.fptr = ff->f; - } else { - char realmode[3]; - char *f = (mp->find_file)(mp, fname, fmode, ftype); - if (f == NULL) - return NULL; - realmode[0] = *fmode; - realmode[1] = 'b'; - realmode[2] = 0; - ff->f = fopen(f, realmode); - free(f); - if ((fmode[0] == 'r') && (ff->f == NULL)) { - free(ff); - return NULL; - } - } - return ff; -} - -static int mplib_get_char(void *f, mp_run_data * run) -{ - int c; - if (f == run->term_in.fptr && run->term_in.data != NULL) { - if (run->term_in.size == 0) { - if (run->term_in.cur != NULL) { - run->term_in.cur = NULL; - } else { - xfree(run->term_in.data); - } - c = EOF; - } else { - run->term_in.size--; - c = *(run->term_in.cur)++; - } - } else { - c = fgetc(f); - } - return c; -} - -static void mplib_unget_char(void *f, mp_run_data * run, int c) -{ - if (f == run->term_in.fptr && run->term_in.cur != NULL) { - run->term_in.size++; - run->term_in.cur--; - } else { - ungetc(c, f); - } -} - - -static char *mplib_read_ascii_file(MP mp, void *ff, size_t * size) -{ - char *s = NULL; - if (ff != NULL) { - int c; - size_t len = 0, lim = 128; - mp_run_data *run = mp_rundata(mp); - FILE *f = ((File *) ff)->f; - if (f == NULL) - return NULL; - *size = 0; - c = mplib_get_char(f, run); - if (c == EOF) - return NULL; - s = malloc(lim); - if (s == NULL) - return NULL; - while (c != EOF && c != '\n' && c != '\r') { - if (len == lim) { - s = xrealloc(s, (lim + (lim >> 2)),1); - if (s == NULL) - return NULL; - lim += (lim >> 2); - } - s[len++] = c; - c = mplib_get_char(f, run); - } - if (c == '\r') { - c = mplib_get_char(f, run); - if (c != EOF && c != '\n') - mplib_unget_char(f, run, c); - } - s[len] = 0; - *size = len; - } - return s; -} - -static void mp_append_string (MP mp, mp_stream *a,const char *b) { - size_t l = strlen(b); - if ((a->used+l)>=a->size) { - a->size += 256+(a->size)/5+l; - a->data = xrealloc(a->data,a->size,1); - } - (void)strcpy(a->data+a->used,b); - a->used += l; -} - - -static void mplib_write_ascii_file(MP mp, void *ff, const char *s) -{ - if (ff != NULL) { - void *f = ((File *) ff)->f; - mp_run_data *run = mp_rundata(mp); - if (f != NULL) { - if (f == run->term_out.fptr) { - mp_append_string(mp,&(run->term_out), s); - } else if (f == run->error_out.fptr) { - mp_append_string(mp,&(run->error_out), s); - } else if (f == run->log_out.fptr) { - mp_append_string(mp,&(run->log_out), s); - } else if (f == run->ps_out.fptr) { - mp_append_string(mp,&(run->ps_out), s); - } else { - fprintf((FILE *) f, "%s", s); - } - } - } -} - -static void mplib_read_binary_file(MP mp, void *ff, void **data, size_t * size) -{ - (void) mp; - if (ff != NULL) { - size_t len = 0; - FILE *f = ((File *) ff)->f; - if (f != NULL) - len = fread(*data, 1, *size, f); - *size = len; - } -} - -static void mplib_write_binary_file(MP mp, void *ff, void *s, size_t size) -{ - (void) mp; - if (ff != NULL) { - FILE *f = ((File *) ff)->f; - if (f != NULL) - (void)fwrite(s, size, 1, f); - } -} - -static void mplib_close_file(MP mp, void *ff) -{ - if (ff != NULL) { - mp_run_data *run = mp_rundata(mp); - void *f = ((File *) ff)->f; - if (f != NULL) { - if (f != run->term_out.fptr - && f != run->error_out.fptr - && f != run->log_out.fptr - && f != run->ps_out.fptr - && f != run->term_in.fptr) { - fclose(f); - } - } - free(ff); - } -} - -static int mplib_eof_file(MP mp, void *ff) -{ - if (ff != NULL) { - mp_run_data *run = mp_rundata(mp); - FILE *f = ((File *) ff)->f; - if (f == NULL) - return 1; - if (f == run->term_in.fptr && run->term_in.data != NULL) { - return (run->term_in.size == 0); - } - return feof(f); - } - return 1; -} - -static void mplib_flush_file(MP mp, void *ff) -{ - (void) mp; - (void) ff; - return; -} - -static void mplib_shipout_backend(MP mp, int h) -{ - mp_edge_object *hh = mp_gr_export(mp, h); - if (hh) { - mp_run_data *run = mp_rundata(mp); - if (run->edges==NULL) { - run->edges = hh; - } else { - mp_edge_object *p = run->edges; - while (p->next!=NULL) { p = p->next; } - p->next = hh; - } - } -} - - -@ This is where we fill them all in. -@<Prepare function pointers for non-interactive use@>= -{ - mp->open_file = mplib_open_file; - mp->close_file = mplib_close_file; - mp->eof_file = mplib_eof_file; - mp->flush_file = mplib_flush_file; - mp->write_ascii_file = mplib_write_ascii_file; - mp->read_ascii_file = mplib_read_ascii_file; - mp->write_binary_file = mplib_write_binary_file; - mp->read_binary_file = mplib_read_binary_file; - mp->shipout_backend = mplib_shipout_backend; -} - -@ Perhaps this is the most important API function in the library. - -@<Exported function ...@>= -extern mp_run_data *mp_rundata (MP mp) ; - -@ @c -mp_run_data *mp_rundata (MP mp) { - return &(mp->run_data); -} - -@ @<Dealloc ...@>= -mp_free_stream(&(mp->run_data.term_in)); -mp_free_stream(&(mp->run_data.term_out)); -mp_free_stream(&(mp->run_data.log_out)); -mp_free_stream(&(mp->run_data.error_out)); -mp_free_stream(&(mp->run_data.ps_out)); - -@ @<Finish non-interactive use@>= -xfree(mp->term_out); -xfree(mp->term_in); -xfree(mp->err_out); - -@ @<Start non-interactive work@>= -@<Initialize the output routines@>; -mp->input_ptr=0; mp->max_in_stack=0; -mp->in_open=0; mp->open_parens=0; mp->max_buf_stack=0; -mp->param_ptr=0; mp->max_param_stack=0; -start = loc = iindex = 0; mp->first = 0; -line=0; name=is_term; -mp->mpx_name[0]=absent; -mp->force_eof=false; -t_open_in; -mp->scanner_status=normal; -if (mp->mem_ident==NULL) { - if ( ! mp_load_mem_file(mp) ) { - (mp->close_file)(mp, mp->mem_file); - mp->history = mp_fatal_error_stop; - return mp->history; - } - (mp->close_file)(mp, mp->mem_file); -} -mp_fix_date_and_time(mp); -if (mp->random_seed==0) - mp->random_seed = (mp->internal[mp_time] / unity)+mp->internal[mp_day]; -mp_init_randoms(mp, mp->random_seed); -@<Initialize the print |selector|...@>; -mp_open_log_file(mp); -mp_set_job_id(mp); -mp_init_map_file(mp, mp->troff_mode); -mp->history=mp_spotless; /* ready to go! */ -if (mp->troff_mode) { - mp->internal[mp_gtroffmode]=unity; - mp->internal[mp_prologues]=unity; -} -if ( mp->start_sym>0 ) { /* insert the `\&{everyjob}' symbol */ - mp->cur_sym=mp->start_sym; mp_back_input(mp); -} - -@ @c -int mp_execute (MP mp, char *s, size_t l) { - mp_reset_stream(&(mp->run_data.term_out)); - mp_reset_stream(&(mp->run_data.log_out)); - mp_reset_stream(&(mp->run_data.error_out)); - mp_reset_stream(&(mp->run_data.ps_out)); - if (mp->finished) { - return mp->history; - } else if (!mp->noninteractive) { - mp->history = mp_fatal_error_stop ; - return mp->history; - } - if (mp->history < mp_fatal_error_stop ) { - xfree(mp->jump_buf); - mp->jump_buf = malloc(sizeof(jmp_buf)); - if (mp->jump_buf == NULL || setjmp(*(mp->jump_buf)) != 0) { - return mp->history; - } - if (s==NULL) { /* this signals EOF */ - mp_final_cleanup(mp); /* prepare for death */ - mp_close_files_and_terminate(mp); - return mp->history; - } - mp->tally=0; - mp->term_offset=0; mp->file_offset=0; - /* Perhaps some sort of warning here when |data| is not - * yet exhausted would be nice ... this happens after errors - */ - if (mp->run_data.term_in.data) - xfree(mp->run_data.term_in.data); - mp->run_data.term_in.data = xstrdup(s); - mp->run_data.term_in.cur = mp->run_data.term_in.data; - mp->run_data.term_in.size = l; - if (mp->run_state == 0) { - mp->selector=term_only; - @<Start non-interactive work@>; - } - mp->run_state =1; - (void)mp_input_ln(mp,mp->term_in); - mp_firm_up_the_line(mp); - mp->buffer[limit]=xord('%'); - mp->first=(size_t)(limit+1); - loc=start; - do { - mp_do_statement(mp); - } while (mp->cur_cmd!=stop); - mp_final_cleanup(mp); - mp_close_files_and_terminate(mp); - } - return mp->history; -} - -@ This function cleans up -@c -int mp_finish (MP mp) { - int history = 0; - if (mp->finished || mp->history >= mp_fatal_error_stop) { - history = mp->history; - mp_free(mp); - return history; - } - xfree(mp->jump_buf); - mp->jump_buf = malloc(sizeof(jmp_buf)); - if (mp->jump_buf == NULL || setjmp(*(mp->jump_buf)) != 0) { - history = mp->history; - } else { - history = mp->history; - mp_final_cleanup(mp); /* prepare for death */ - } - mp_close_files_and_terminate(mp); - mp_free(mp); - return history; -} - -@ People may want to know the library version -@c -char * mp_metapost_version (void) { - return mp_strdup(metapost_version); -} - -@ @<Exported function headers@>= -int mp_run (MP mp); -int mp_execute (MP mp, char *s, size_t l); -int mp_finish (MP mp); -char * mp_metapost_version (void); - -@ @<Put each...@>= -mp_primitive(mp, "end",stop,0); -@:end_}{\&{end} primitive@> -mp_primitive(mp, "dump",stop,1); -@:dump_}{\&{dump} primitive@> - -@ @<Cases of |print_cmd...@>= -case stop: - if ( m==0 ) mp_print(mp, "end"); - else mp_print(mp, "dump"); - break; - -@* \[41] Commands. -Let's turn now to statements that are classified as ``commands'' because -of their imperative nature. We'll begin with simple ones, so that it -will be clear how to hook command processing into the |do_statement| routine; -then we'll tackle the tougher commands. - -Here's one of the simplest: - -@<Cases of |do_statement|...@>= -case mp_random_seed: mp_do_random_seed(mp); break; - -@ @<Declare action procedures for use by |do_statement|@>= -static void mp_do_random_seed (MP mp) ; - -@ @c void mp_do_random_seed (MP mp) { - mp_get_x_next(mp); - if ( mp->cur_cmd!=assignment ) { - mp_missing_err(mp, ":="); -@.Missing `:='@> - help1("Always say `randomseed:=<numeric expression>'."); - mp_back_error(mp); - }; - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type!=mp_known ) { - exp_err("Unknown value will be ignored"); -@.Unknown value...ignored@> - help2("Your expression was too random for me to handle,", - "so I won't change the random seed just now."); - mp_put_get_flush_error(mp, 0); - } else { - @<Initialize the random seed to |cur_exp|@>; - } -} - -@ @<Initialize the random seed to |cur_exp|@>= -{ - mp_init_randoms(mp, mp->cur_exp); - if ( mp->selector>=log_only && mp->selector<write_file) { - mp->old_setting=mp->selector; mp->selector=log_only; - mp_print_nl(mp, "{randomseed:="); - mp_print_scaled(mp, mp->cur_exp); - mp_print_char(mp, xord('}')); - mp_print_nl(mp, ""); mp->selector=mp->old_setting; - } -} - -@ And here's another simple one (somewhat different in flavor): - -@<Cases of |do_statement|...@>= -case mode_command: - mp_print_ln(mp); mp->interaction=mp->cur_mod; - @<Initialize the print |selector| based on |interaction|@>; - if ( mp->log_opened ) mp->selector=mp->selector+2; - mp_get_x_next(mp); - break; - -@ @<Put each...@>= -mp_primitive(mp, "batchmode",mode_command,mp_batch_mode); -@:mp_batch_mode_}{\&{batchmode} primitive@> -mp_primitive(mp, "nonstopmode",mode_command,mp_nonstop_mode); -@:mp_nonstop_mode_}{\&{nonstopmode} primitive@> -mp_primitive(mp, "scrollmode",mode_command,mp_scroll_mode); -@:mp_scroll_mode_}{\&{scrollmode} primitive@> -mp_primitive(mp, "errorstopmode",mode_command,mp_error_stop_mode); -@:mp_error_stop_mode_}{\&{errorstopmode} primitive@> - -@ @<Cases of |print_cmd_mod|...@>= -case mode_command: - switch (m) { - case mp_batch_mode: mp_print(mp, "batchmode"); break; - case mp_nonstop_mode: mp_print(mp, "nonstopmode"); break; - case mp_scroll_mode: mp_print(mp, "scrollmode"); break; - default: mp_print(mp, "errorstopmode"); break; - } - break; - -@ The `\&{inner}' and `\&{outer}' commands are only slightly harder. - -@<Cases of |do_statement|...@>= -case protection_command: mp_do_protection(mp); break; - -@ @<Put each...@>= -mp_primitive(mp, "inner",protection_command,0); -@:inner_}{\&{inner} primitive@> -mp_primitive(mp, "outer",protection_command,1); -@:outer_}{\&{outer} primitive@> - -@ @<Cases of |print_cmd...@>= -case protection_command: - if ( m==0 ) mp_print(mp, "inner"); - else mp_print(mp, "outer"); - break; - -@ @<Declare action procedures for use by |do_statement|@>= -static void mp_do_protection (MP mp) ; - -@ @c void mp_do_protection (MP mp) { - int m; /* 0 to unprotect, 1 to protect */ - halfword t; /* the |eq_type| before we change it */ - m=mp->cur_mod; - do { - mp_get_symbol(mp); t=eq_type(mp->cur_sym); - if ( m==0 ) { - if ( t>=outer_tag ) - eq_type(mp->cur_sym)=t-outer_tag; - } else if ( t<outer_tag ) { - eq_type(mp->cur_sym)=t+outer_tag; - } - mp_get_x_next(mp); - } while (mp->cur_cmd==comma); -} - -@ \MP\ never defines the tokens `\.(' and `\.)' to be primitives, but -plain \MP\ begins with the declaration `\&{delimiters} \.{()}'. Such a -declaration assigns the command code |left_delimiter| to `\.{(}' and -|right_delimiter| to `\.{)}'; the |equiv| of each delimiter is the -hash address of its mate. - -@<Cases of |do_statement|...@>= -case delimiters: mp_def_delims(mp); break; - -@ @<Declare action procedures for use by |do_statement|@>= -static void mp_def_delims (MP mp) ; - -@ @c void mp_def_delims (MP mp) { - pointer l_delim,r_delim; /* the new delimiter pair */ - mp_get_clear_symbol(mp); l_delim=mp->cur_sym; - mp_get_clear_symbol(mp); r_delim=mp->cur_sym; - eq_type(l_delim)=left_delimiter; equiv(l_delim)=r_delim; - eq_type(r_delim)=right_delimiter; equiv(r_delim)=l_delim; - mp_get_x_next(mp); -} - -@ Here is a procedure that is called when \MP\ has reached a point -where some right delimiter is mandatory. - -@<Declarations@>= -static void mp_check_delimiter (MP mp,pointer l_delim, pointer r_delim); - -@ @c -void mp_check_delimiter (MP mp,pointer l_delim, pointer r_delim) { - if ( mp->cur_cmd==right_delimiter ) - if ( mp->cur_mod==l_delim ) - return; - if ( mp->cur_sym!=r_delim ) { - mp_missing_err(mp, str(text(r_delim))); -@.Missing `)'@> - help2("I found no right delimiter to match a left one. So I've", - "put one in, behind the scenes; this may fix the problem."); - mp_back_error(mp); - } else { - print_err("The token `"); mp_print_text(r_delim); -@.The token...delimiter@> - mp_print(mp, "' is no longer a right delimiter"); - help3("Strange: This token has lost its former meaning!", - "I'll read it as a right delimiter this time;", - "but watch out, I'll probably miss it later."); - mp_error(mp); - } -} - -@ The next four commands save or change the values associated with tokens. - -@<Cases of |do_statement|...@>= -case save_command: - do { - mp_get_symbol(mp); mp_save_variable(mp, mp->cur_sym); mp_get_x_next(mp); - } while (mp->cur_cmd==comma); - break; -case interim_command: mp_do_interim(mp); break; -case let_command: mp_do_let(mp); break; -case new_internal: mp_do_new_internal(mp); break; - -@ @<Declare action procedures for use by |do_statement|@>= -static void mp_do_statement (MP mp); -static void mp_do_interim (MP mp); - -@ @c void mp_do_interim (MP mp) { - mp_get_x_next(mp); - if ( mp->cur_cmd!=internal_quantity ) { - print_err("The token `"); -@.The token...quantity@> - if ( mp->cur_sym==0 ) mp_print(mp, "(%CAPSULE)"); - else mp_print_text(mp->cur_sym); - mp_print(mp, "' isn't an internal quantity"); - help1("Something like `tracingonline' should follow `interim'."); - mp_back_error(mp); - } else { - mp_save_internal(mp, mp->cur_mod); mp_back_input(mp); - } - mp_do_statement(mp); -} - -@ The following procedure is careful not to undefine the left-hand symbol -too soon, lest commands like `{\tt let x=x}' have a surprising effect. - -@<Declare action procedures for use by |do_statement|@>= -static void mp_do_let (MP mp) ; - -@ @c void mp_do_let (MP mp) { - pointer l; /* hash location of the left-hand symbol */ - mp_get_symbol(mp); l=mp->cur_sym; mp_get_x_next(mp); - if ( mp->cur_cmd!=equals ) if ( mp->cur_cmd!=assignment ) { - mp_missing_err(mp, "="); -@.Missing `='@> - help3("You should have said `let symbol = something'.", - "But don't worry; I'll pretend that an equals sign", - "was present. The next token I read will be `something'."); - mp_back_error(mp); - } - mp_get_symbol(mp); - switch (mp->cur_cmd) { - case defined_macro: case secondary_primary_macro: - case tertiary_secondary_macro: case expression_tertiary_macro: - add_mac_ref(mp->cur_mod); - break; - default: - break; - } - mp_clear_symbol(mp, l,false); eq_type(l)=mp->cur_cmd; - if ( mp->cur_cmd==tag_token ) equiv(l)=null; - else equiv(l)=mp->cur_mod; - mp_get_x_next(mp); -} - -@ @<Declarations@>= -static void mp_do_new_internal (MP mp) ; - -@ @<Internal library ...@>= -void mp_grow_internals (MP mp, int l); - -@ @c -void mp_grow_internals (MP mp, int l) { - scaled *internal; - char * *int_name; - int k; - if ( hash_end+l>max_halfword ) { - mp_confusion(mp, "out of memory space"); /* can't be reached */ - } - int_name = xmalloc ((l+1),sizeof(char *)); - internal = xmalloc ((l+1),sizeof(scaled)); - for (k=0;k<=l; k++ ) { - if (k<=mp->max_internal) { - internal[k]=mp->internal[k]; - int_name[k]=mp->int_name[k]; - } else { - internal[k]=0; - int_name[k]=NULL; - } - } - xfree(mp->internal); xfree(mp->int_name); - mp->int_name = int_name; - mp->internal = internal; - mp->max_internal = l; -} - -void mp_do_new_internal (MP mp) { - do { - if ( mp->int_ptr==mp->max_internal ) { - mp_grow_internals(mp, (mp->max_internal + (mp->max_internal/4))); - } - mp_get_clear_symbol(mp); incr(mp->int_ptr); - eq_type(mp->cur_sym)=internal_quantity; - equiv(mp->cur_sym)=mp->int_ptr; - if(mp->int_name[mp->int_ptr]!=NULL) - xfree(mp->int_name[mp->int_ptr]); - mp->int_name[mp->int_ptr]=str(text(mp->cur_sym)); - mp->internal[mp->int_ptr]=0; - mp_get_x_next(mp); - } while (mp->cur_cmd==comma); -} - -@ @<Dealloc variables@>= -for (k=0;k<=mp->max_internal;k++) { - xfree(mp->int_name[k]); -} -xfree(mp->internal); -xfree(mp->int_name); - - -@ The various `\&{show}' commands are distinguished by modifier fields -in the usual way. - -@d show_token_code 0 /* show the meaning of a single token */ -@d show_stats_code 1 /* show current memory and string usage */ -@d show_code 2 /* show a list of expressions */ -@d show_var_code 3 /* show a variable and its descendents */ -@d show_dependencies_code 4 /* show dependent variables in terms of independents */ - -@<Put each...@>= -mp_primitive(mp, "showtoken",show_command,show_token_code); -@:show_token_}{\&{showtoken} primitive@> -mp_primitive(mp, "showstats",show_command,show_stats_code); -@:show_stats_}{\&{showstats} primitive@> -mp_primitive(mp, "show",show_command,show_code); -@:show_}{\&{show} primitive@> -mp_primitive(mp, "showvariable",show_command,show_var_code); -@:show_var_}{\&{showvariable} primitive@> -mp_primitive(mp, "showdependencies",show_command,show_dependencies_code); -@:show_dependencies_}{\&{showdependencies} primitive@> - -@ @<Cases of |print_cmd...@>= -case show_command: - switch (m) { - case show_token_code:mp_print(mp, "showtoken"); break; - case show_stats_code:mp_print(mp, "showstats"); break; - case show_code:mp_print(mp, "show"); break; - case show_var_code:mp_print(mp, "showvariable"); break; - default: mp_print(mp, "showdependencies"); break; - } - break; - -@ @<Cases of |do_statement|...@>= -case show_command:mp_do_show_whatever(mp); break; - -@ The value of |cur_mod| controls the |verbosity| in the |print_exp| routine: -if it's |show_code|, complicated structures are abbreviated, otherwise -they aren't. - -@<Declare action procedures for use by |do_statement|@>= -static void mp_do_show (MP mp) ; - -@ @c void mp_do_show (MP mp) { - do { - mp_get_x_next(mp); mp_scan_expression(mp); - mp_print_nl(mp, ">> "); -@.>>@> - mp_print_exp(mp, null,2); mp_flush_cur_exp(mp, 0); - } while (mp->cur_cmd==comma); -} - -@ @<Declare action procedures for use by |do_statement|@>= -static void mp_disp_token (MP mp) ; - -@ @c void mp_disp_token (MP mp) { - mp_print_nl(mp, "> "); -@.>\relax@> - if ( mp->cur_sym==0 ) { - @<Show a numeric or string or capsule token@>; - } else { - mp_print_text(mp->cur_sym); mp_print_char(mp, xord('=')); - if ( eq_type(mp->cur_sym)>=outer_tag ) mp_print(mp, "(outer) "); - mp_print_cmd_mod(mp, mp->cur_cmd,mp->cur_mod); - if ( mp->cur_cmd==defined_macro ) { - mp_print_ln(mp); mp_show_macro(mp, mp->cur_mod,null,100000); - } /* this avoids recursion between |show_macro| and |print_cmd_mod| */ -@^recursion@> - } -} - -@ @<Show a numeric or string or capsule token@>= -{ - if ( mp->cur_cmd==numeric_token ) { - mp_print_scaled(mp, mp->cur_mod); - } else if ( mp->cur_cmd==capsule_token ) { - mp_print_capsule(mp,mp->cur_mod); - } else { - mp_print_char(mp, xord('"')); - mp_print_str(mp, mp->cur_mod); mp_print_char(mp, xord('"')); - delete_str_ref(mp->cur_mod); - } -} - -@ The following cases of |print_cmd_mod| might arise in connection -with |disp_token|, although they don't necessarily correspond to -primitive tokens. - -@<Cases of |print_cmd_...@>= -case left_delimiter: -case right_delimiter: - if ( c==left_delimiter ) mp_print(mp, "left"); - else mp_print(mp, "right"); - mp_print(mp, " delimiter that matches "); - mp_print_text(m); - break; -case tag_token: - if ( m==null ) mp_print(mp, "tag"); - else mp_print(mp, "variable"); - break; -case defined_macro: - mp_print(mp, "macro:"); - break; -case secondary_primary_macro: -case tertiary_secondary_macro: -case expression_tertiary_macro: - mp_print_cmd_mod(mp, macro_def,c); - mp_print(mp, "'d macro:"); - mp_print_ln(mp); mp_show_token_list(mp, mp_link(mp_link(m)),null,1000,0); - break; -case repeat_loop: - mp_print(mp, "[repeat the loop]"); - break; -case internal_quantity: - mp_print(mp, mp->int_name[m]); - break; - -@ @<Declare action procedures for use by |do_statement|@>= -static void mp_do_show_token (MP mp) ; - -@ @c void mp_do_show_token (MP mp) { - do { - get_t_next; mp_disp_token(mp); - mp_get_x_next(mp); - } while (mp->cur_cmd==comma); -} - -@ @<Declare action procedures for use by |do_statement|@>= -static void mp_do_show_stats (MP mp) ; - -@ @c void mp_do_show_stats (MP mp) { - mp_print_nl(mp, "Memory usage "); -@.Memory usage...@> - mp_print_int(mp, mp->var_used); mp_print_char(mp, xord('&')); mp_print_int(mp, mp->dyn_used); - mp_print(mp, " ("); mp_print_int(mp, mp->hi_mem_min-mp->lo_mem_max-1); - mp_print(mp, " still untouched)"); mp_print_ln(mp); - mp_print_nl(mp, "String usage "); - mp_print_int(mp, mp->strs_in_use-mp->init_str_use); - mp_print_char(mp, xord('&')); mp_print_int(mp, mp->pool_in_use-mp->init_pool_ptr); - mp_print(mp, " ("); - mp_print_int(mp, mp->max_strings-1-mp->strs_used_up); mp_print_char(mp, xord('&')); - mp_print_int(mp, mp->pool_size-mp->pool_ptr); - mp_print(mp, " now untouched)"); mp_print_ln(mp); - mp_get_x_next(mp); -} - -@ Here's a recursive procedure that gives an abbreviated account -of a variable, for use by |do_show_var|. - -@<Declare action procedures for use by |do_statement|@>= -static void mp_disp_var (MP mp,pointer p) ; - -@ @c void mp_disp_var (MP mp,pointer p) { - pointer q; /* traverses attributes and subscripts */ - int n; /* amount of macro text to show */ - if ( mp_type(p)==mp_structured ) { - @<Descend the structure@>; - } else if ( mp_type(p)>=mp_unsuffixed_macro ) { - @<Display a variable macro@>; - } else if ( mp_type(p)!=undefined ){ - mp_print_nl(mp, ""); mp_print_variable_name(mp, p); - mp_print_char(mp, xord('=')); - mp_print_exp(mp, p,0); - } -} - -@ @<Descend the structure@>= -{ - q=attr_head(p); - do { mp_disp_var(mp, q); q=mp_link(q); } while (q!=end_attr); - q=subscr_head(p); - while ( mp_name_type(q)==mp_subscr ) { - mp_disp_var(mp, q); q=mp_link(q); - } -} - -@ @<Display a variable macro@>= -{ - mp_print_nl(mp, ""); mp_print_variable_name(mp, p); - if ( mp_type(p)>mp_unsuffixed_macro ) - mp_print(mp, "@@#"); /* |suffixed_macro| */ - mp_print(mp, "=macro:"); - if ( (int)mp->file_offset>=mp->max_print_line-20 ) n=5; - else n=mp->max_print_line-mp->file_offset-15; - mp_show_macro(mp, value(p),null,n); -} - -@ @<Declare action procedures for use by |do_statement|@>= -static void mp_do_show_var (MP mp) ; - -@ @c void mp_do_show_var (MP mp) { - do { - get_t_next; - if ( mp->cur_sym>0 ) if ( mp->cur_sym<=hash_end ) - if ( mp->cur_cmd==tag_token ) if ( mp->cur_mod!=null ) { - mp_disp_var(mp, mp->cur_mod); goto DONE; - } - mp_disp_token(mp); - DONE: - mp_get_x_next(mp); - } while (mp->cur_cmd==comma); -} - -@ @<Declare action procedures for use by |do_statement|@>= -static void mp_do_show_dependencies (MP mp) ; - -@ @c void mp_do_show_dependencies (MP mp) { - pointer p; /* link that runs through all dependencies */ - p=mp_link(dep_head); - while ( p!=dep_head ) { - if ( mp_interesting(mp, p) ) { - mp_print_nl(mp, ""); mp_print_variable_name(mp, p); - if ( mp_type(p)==mp_dependent ) mp_print_char(mp, xord('=')); - else mp_print(mp, " = "); /* extra spaces imply proto-dependency */ - mp_print_dependency(mp, dep_list(p),mp_type(p)); - } - p=dep_list(p); - while ( mp_info(p)!=null ) p=mp_link(p); - p=mp_link(p); - } - mp_get_x_next(mp); -} - -@ Finally we are ready for the procedure that governs all of the -show commands. - -@<Declare action procedures for use by |do_statement|@>= -static void mp_do_show_whatever (MP mp) ; - -@ @c void mp_do_show_whatever (MP mp) { - if ( mp->interaction==mp_error_stop_mode ) wake_up_terminal; - switch (mp->cur_mod) { - case show_token_code:mp_do_show_token(mp); break; - case show_stats_code:mp_do_show_stats(mp); break; - case show_code:mp_do_show(mp); break; - case show_var_code:mp_do_show_var(mp); break; - case show_dependencies_code:mp_do_show_dependencies(mp); break; - } /* there are no other cases */ - if ( mp->internal[mp_showstopping]>0 ){ - print_err("OK"); -@.OK@> - if ( mp->interaction<mp_error_stop_mode ) { - help0; decr(mp->error_count); - } else { - help1("This isn't an error message; I'm just showing something."); - } - if ( mp->cur_cmd==semicolon ) mp_error(mp); - else mp_put_get_error(mp); - } -} - -@ The `\&{addto}' command needs the following additional primitives: - -@d double_path_code 0 /* command modifier for `\&{doublepath}' */ -@d contour_code 1 /* command modifier for `\&{contour}' */ -@d also_code 2 /* command modifier for `\&{also}' */ - -@ Pre and postscripts need two new identifiers: - -@d with_mp_pre_script 11 -@d with_mp_post_script 13 - -@<Put each...@>= -mp_primitive(mp, "doublepath",thing_to_add,double_path_code); -@:double_path_}{\&{doublepath} primitive@> -mp_primitive(mp, "contour",thing_to_add,contour_code); -@:contour_}{\&{contour} primitive@> -mp_primitive(mp, "also",thing_to_add,also_code); -@:also_}{\&{also} primitive@> -mp_primitive(mp, "withpen",with_option,mp_pen_type); -@:with_pen_}{\&{withpen} primitive@> -mp_primitive(mp, "dashed",with_option,mp_picture_type); -@:dashed_}{\&{dashed} primitive@> -mp_primitive(mp, "withprescript",with_option,with_mp_pre_script); -@:with_mp_pre_script_}{\&{withprescript} primitive@> -mp_primitive(mp, "withpostscript",with_option,with_mp_post_script); -@:with_mp_post_script_}{\&{withpostscript} primitive@> -mp_primitive(mp, "withoutcolor",with_option,mp_no_model); -@:with_color_}{\&{withoutcolor} primitive@> -mp_primitive(mp, "withgreyscale",with_option,mp_grey_model); -@:with_color_}{\&{withgreyscale} primitive@> -mp_primitive(mp, "withcolor",with_option,mp_uninitialized_model); -@:with_color_}{\&{withcolor} primitive@> -/* \&{withrgbcolor} is an alias for \&{withcolor} */ -mp_primitive(mp, "withrgbcolor",with_option,mp_rgb_model); -@:with_color_}{\&{withrgbcolor} primitive@> -mp_primitive(mp, "withcmykcolor",with_option,mp_cmyk_model); -@:with_color_}{\&{withcmykcolor} primitive@> - -@ @<Cases of |print_cmd...@>= -case thing_to_add: - if ( m==contour_code ) mp_print(mp, "contour"); - else if ( m==double_path_code ) mp_print(mp, "doublepath"); - else mp_print(mp, "also"); - break; -case with_option: - if ( m==mp_pen_type ) mp_print(mp, "withpen"); - else if ( m==with_mp_pre_script ) mp_print(mp, "withprescript"); - else if ( m==with_mp_post_script ) mp_print(mp, "withpostscript"); - else if ( m==mp_no_model ) mp_print(mp, "withoutcolor"); - else if ( m==mp_rgb_model ) mp_print(mp, "withrgbcolor"); - else if ( m==mp_uninitialized_model ) mp_print(mp, "withcolor"); - else if ( m==mp_cmyk_model ) mp_print(mp, "withcmykcolor"); - else if ( m==mp_grey_model ) mp_print(mp, "withgreyscale"); - else mp_print(mp, "dashed"); - break; - -@ The |scan_with_list| procedure parses a $\langle$with list$\rangle$ and -updates the list of graphical objects starting at |p|. Each $\langle$with -clause$\rangle$ updates all graphical objects whose |type| is compatible. -Other objects are ignored. - -@<Declare action procedures for use by |do_statement|@>= -static void mp_scan_with_list (MP mp,pointer p) ; - -@ @c void mp_scan_with_list (MP mp,pointer p) { - quarterword t; /* |cur_mod| of the |with_option| (should match |cur_type|) */ - pointer q; /* for list manipulation */ - unsigned old_setting; /* saved |selector| setting */ - pointer k; /* for finding the near-last item in a list */ - str_number s; /* for string cleanup after combining */ - pointer cp,pp,dp,ap,bp; - /* objects being updated; |void| initially; |null| to suppress update */ - cp=mp_void; pp=mp_void; dp=mp_void; ap=mp_void; bp=mp_void; - k=0; - while ( mp->cur_cmd==with_option ){ - t=mp->cur_mod; - mp_get_x_next(mp); - if ( t!=mp_no_model ) mp_scan_expression(mp); - if (((t==with_mp_pre_script)&&(mp->cur_type!=mp_string_type))|| - ((t==with_mp_post_script)&&(mp->cur_type!=mp_string_type))|| - ((t==mp_uninitialized_model)&& - ((mp->cur_type!=mp_cmykcolor_type)&&(mp->cur_type!=mp_color_type) - &&(mp->cur_type!=mp_known)&&(mp->cur_type!=mp_boolean_type)))|| - ((t==mp_cmyk_model)&&(mp->cur_type!=mp_cmykcolor_type))|| - ((t==mp_rgb_model)&&(mp->cur_type!=mp_color_type))|| - ((t==mp_grey_model)&&(mp->cur_type!=mp_known))|| - ((t==mp_pen_type)&&(mp->cur_type!=t))|| - ((t==mp_picture_type)&&(mp->cur_type!=t)) ) { - @<Complain about improper type@>; - } else if ( t==mp_uninitialized_model ) { - if ( cp==mp_void ) @<Make |cp| a colored object in object list~|p|@>; - if ( cp!=null ) - @<Transfer a color from the current expression to object~|cp|@>; - mp_flush_cur_exp(mp, 0); - } else if ( t==mp_rgb_model ) { - if ( cp==mp_void ) @<Make |cp| a colored object in object list~|p|@>; - if ( cp!=null ) - @<Transfer a rgbcolor from the current expression to object~|cp|@>; - mp_flush_cur_exp(mp, 0); - } else if ( t==mp_cmyk_model ) { - if ( cp==mp_void ) @<Make |cp| a colored object in object list~|p|@>; - if ( cp!=null ) - @<Transfer a cmykcolor from the current expression to object~|cp|@>; - mp_flush_cur_exp(mp, 0); - } else if ( t==mp_grey_model ) { - if ( cp==mp_void ) @<Make |cp| a colored object in object list~|p|@>; - if ( cp!=null ) - @<Transfer a greyscale from the current expression to object~|cp|@>; - mp_flush_cur_exp(mp, 0); - } else if ( t==mp_no_model ) { - if ( cp==mp_void ) @<Make |cp| a colored object in object list~|p|@>; - if ( cp!=null ) - @<Transfer a noncolor from the current expression to object~|cp|@>; - } else if ( t==mp_pen_type ) { - if ( pp==mp_void ) @<Make |pp| an object in list~|p| that needs a pen@>; - if ( pp!=null ) { - if ( mp_pen_p(pp)!=null ) mp_toss_knot_list(mp, mp_pen_p(pp)); - mp_pen_p(pp)=mp->cur_exp; mp->cur_type=mp_vacuous; - } - } else if ( t==with_mp_pre_script ) { - if ( ap==mp_void ) - ap=p; - while ( (ap!=null)&&(! has_color(ap)) ) - ap=mp_link(ap); - if ( ap!=null ) { - if ( mp_pre_script(ap)!=null ) { /* build a new,combined string */ - s=mp_pre_script(ap); - old_setting=mp->selector; - mp->selector=new_string; - str_room(length(mp_pre_script(ap))+length(mp->cur_exp)+2); - mp_print_str(mp, mp->cur_exp); - append_char(13); /* a forced \ps\ newline */ - mp_print_str(mp, mp_pre_script(ap)); - mp_pre_script(ap)=mp_make_string(mp); - delete_str_ref(s); - mp->selector=old_setting; - } else { - mp_pre_script(ap)=mp->cur_exp; - } - mp->cur_type=mp_vacuous; - } - } else if ( t==with_mp_post_script ) { - if ( bp==mp_void ) - k=p; - bp=k; - while ( mp_link(k)!=null ) { - k=mp_link(k); - if ( has_color(k) ) bp=k; - } - if ( bp!=null ) { - if ( mp_post_script(bp)!=null ) { - s=mp_post_script(bp); - old_setting=mp->selector; - mp->selector=new_string; - str_room(length(mp_post_script(bp))+length(mp->cur_exp)+2); - mp_print_str(mp, mp_post_script(bp)); - append_char(13); /* a forced \ps\ newline */ - mp_print_str(mp, mp->cur_exp); - mp_post_script(bp)=mp_make_string(mp); - delete_str_ref(s); - mp->selector=old_setting; - } else { - mp_post_script(bp)=mp->cur_exp; - } - mp->cur_type=mp_vacuous; - } - } else { - if ( dp==mp_void ) { - @<Make |dp| a stroked node in list~|p|@>; - } - if ( dp!=null ) { - if ( mp_dash_p(dp)!=null ) delete_edge_ref(mp_dash_p(dp)); - mp_dash_p(dp)=mp_make_dashes(mp, mp->cur_exp); - dash_scale(dp)=unity; - mp->cur_type=mp_vacuous; - } - } - } - @<Copy the information from objects |cp|, |pp|, and |dp| into the rest - of the list@>; -} - -@ @<Complain about improper type@>= -{ exp_err("Improper type"); -@.Improper type@> -help2("Next time say `withpen <known pen expression>';", - "I'll ignore the bad `with' clause and look for another."); -if ( t==with_mp_pre_script ) - mp->help_line[1]="Next time say `withprescript <known string expression>';"; -else if ( t==with_mp_post_script ) - mp->help_line[1]="Next time say `withpostscript <known string expression>';"; -else if ( t==mp_picture_type ) - mp->help_line[1]="Next time say `dashed <known picture expression>';"; -else if ( t==mp_uninitialized_model ) - mp->help_line[1]="Next time say `withcolor <known color expression>';"; -else if ( t==mp_rgb_model ) - mp->help_line[1]="Next time say `withrgbcolor <known color expression>';"; -else if ( t==mp_cmyk_model ) - mp->help_line[1]="Next time say `withcmykcolor <known cmykcolor expression>';"; -else if ( t==mp_grey_model ) - mp->help_line[1]="Next time say `withgreyscale <known numeric expression>';";; -mp_put_get_flush_error(mp, 0); -} - -@ Forcing the color to be between |0| and |unity| here guarantees that no -picture will ever contain a color outside the legal range for \ps\ graphics. - -@<Transfer a color from the current expression to object~|cp|@>= -{ if ( mp->cur_type==mp_color_type ) - @<Transfer a rgbcolor from the current expression to object~|cp|@> -else if ( mp->cur_type==mp_cmykcolor_type ) - @<Transfer a cmykcolor from the current expression to object~|cp|@> -else if ( mp->cur_type==mp_known ) - @<Transfer a greyscale from the current expression to object~|cp|@> -else if ( mp->cur_exp==false_code ) - @<Transfer a noncolor from the current expression to object~|cp|@>; -} - -@ @<Transfer a rgbcolor from the current expression to object~|cp|@>= -{ q=value(mp->cur_exp); -cyan_val(cp)=0; -magenta_val(cp)=0; -yellow_val(cp)=0; -black_val(cp)=0; -red_val(cp)=value(red_part_loc(q)); -green_val(cp)=value(green_part_loc(q)); -blue_val(cp)=value(blue_part_loc(q)); -mp_color_model(cp)=mp_rgb_model; -if ( red_val(cp)<0 ) red_val(cp)=0; -if ( green_val(cp)<0 ) green_val(cp)=0; -if ( blue_val(cp)<0 ) blue_val(cp)=0; -if ( red_val(cp)>unity ) red_val(cp)=unity; -if ( green_val(cp)>unity ) green_val(cp)=unity; -if ( blue_val(cp)>unity ) blue_val(cp)=unity; -} - -@ @<Transfer a cmykcolor from the current expression to object~|cp|@>= -{ q=value(mp->cur_exp); -cyan_val(cp)=value(cyan_part_loc(q)); -magenta_val(cp)=value(magenta_part_loc(q)); -yellow_val(cp)=value(yellow_part_loc(q)); -black_val(cp)=value(black_part_loc(q)); -mp_color_model(cp)=mp_cmyk_model; -if ( cyan_val(cp)<0 ) cyan_val(cp)=0; -if ( magenta_val(cp)<0 ) magenta_val(cp)=0; -if ( yellow_val(cp)<0 ) yellow_val(cp)=0; -if ( black_val(cp)<0 ) black_val(cp)=0; -if ( cyan_val(cp)>unity ) cyan_val(cp)=unity; -if ( magenta_val(cp)>unity ) magenta_val(cp)=unity; -if ( yellow_val(cp)>unity ) yellow_val(cp)=unity; -if ( black_val(cp)>unity ) black_val(cp)=unity; -} - -@ @<Transfer a greyscale from the current expression to object~|cp|@>= -{ q=mp->cur_exp; -cyan_val(cp)=0; -magenta_val(cp)=0; -yellow_val(cp)=0; -black_val(cp)=0; -grey_val(cp)=q; -mp_color_model(cp)=mp_grey_model; -if ( grey_val(cp)<0 ) grey_val(cp)=0; -if ( grey_val(cp)>unity ) grey_val(cp)=unity; -} - -@ @<Transfer a noncolor from the current expression to object~|cp|@>= -{ -cyan_val(cp)=0; -magenta_val(cp)=0; -yellow_val(cp)=0; -black_val(cp)=0; -grey_val(cp)=0; -mp_color_model(cp)=mp_no_model; -} - -@ @<Make |cp| a colored object in object list~|p|@>= -{ cp=p; - while ( cp!=null ){ - if ( has_color(cp) ) break; - cp=mp_link(cp); - } -} - -@ @<Make |pp| an object in list~|p| that needs a pen@>= -{ pp=p; - while ( pp!=null ) { - if ( has_pen(pp) ) break; - pp=mp_link(pp); - } -} - -@ @<Make |dp| a stroked node in list~|p|@>= -{ dp=p; - while ( dp!=null ) { - if ( mp_type(dp)==mp_stroked_code ) break; - dp=mp_link(dp); - } -} - -@ @<Copy the information from objects |cp|, |pp|, and |dp| into...@>= -@<Copy |cp|'s color into the colored objects linked to~|cp|@>; -if ( pp>mp_void ) { - @<Copy |mp_pen_p(pp)| into stroked and filled nodes linked to |pp|@>; -} -if ( dp>mp_void ) { - @<Make stroked nodes linked to |dp| refer to |mp_dash_p(dp)|@>; -} - - -@ @<Copy |cp|'s color into the colored objects linked to~|cp|@>= -{ q=mp_link(cp); - while ( q!=null ) { - if ( has_color(q) ) { - red_val(q)=red_val(cp); - green_val(q)=green_val(cp); - blue_val(q)=blue_val(cp); - black_val(q)=black_val(cp); - mp_color_model(q)=mp_color_model(cp); - } - q=mp_link(q); - } -} - -@ @<Copy |mp_pen_p(pp)| into stroked and filled nodes linked to |pp|@>= -{ q=mp_link(pp); - while ( q!=null ) { - if ( has_pen(q) ) { - if ( mp_pen_p(q)!=null ) mp_toss_knot_list(mp, mp_pen_p(q)); - mp_pen_p(q)=copy_pen(mp_pen_p(pp)); - } - q=mp_link(q); - } -} - -@ @<Make stroked nodes linked to |dp| refer to |mp_dash_p(dp)|@>= -{ q=mp_link(dp); - while ( q!=null ) { - if ( mp_type(q)==mp_stroked_code ) { - if ( mp_dash_p(q)!=null ) delete_edge_ref(mp_dash_p(q)); - mp_dash_p(q)=mp_dash_p(dp); - dash_scale(q)=unity; - if ( mp_dash_p(q)!=null ) add_edge_ref(mp_dash_p(q)); - } - q=mp_link(q); - } -} - -@ One of the things we need to do when we've parsed an \&{addto} or -similar command is find the header of a supposed \&{picture} variable, given -a token list for that variable. Since the edge structure is about to be -updated, we use |private_edges| to make sure that this is possible. - -@<Declare action procedures for use by |do_statement|@>= -static pointer mp_find_edges_var (MP mp, pointer t) ; - -@ @c pointer mp_find_edges_var (MP mp, pointer t) { - pointer p; - pointer cur_edges; /* the return value */ - p=mp_find_variable(mp, t); cur_edges=null; - if ( p==null ) { - mp_obliterated(mp, t); mp_put_get_error(mp); - } else if ( mp_type(p)!=mp_picture_type ) { - print_err("Variable "); mp_show_token_list(mp, t,null,1000,0); -@.Variable x is the wrong type@> - mp_print(mp, " is the wrong type ("); - mp_print_type(mp, mp_type(p)); mp_print_char(mp, xord(')')); - help2("I was looking for a \"known\" picture variable.", - "So I'll not change anything just now."); - mp_put_get_error(mp); - } else { - value(p)=mp_private_edges(mp, value(p)); - cur_edges=value(p); - } - mp_flush_node_list(mp, t); - return cur_edges; -} - -@ @<Cases of |do_statement|...@>= -case add_to_command: mp_do_add_to(mp); break; -case bounds_command:mp_do_bounds(mp); break; - -@ @<Put each...@>= -mp_primitive(mp, "clip",bounds_command,mp_start_clip_code); -@:clip_}{\&{clip} primitive@> -mp_primitive(mp, "setbounds",bounds_command,mp_start_bounds_code); -@:set_bounds_}{\&{setbounds} primitive@> - -@ @<Cases of |print_cmd...@>= -case bounds_command: - if ( m==mp_start_clip_code ) mp_print(mp, "clip"); - else mp_print(mp, "setbounds"); - break; - -@ The following function parses the beginning of an \&{addto} or \&{clip} -command: it expects a variable name followed by a token with |cur_cmd=sep| -and then an expression. The function returns the token list for the variable -and stores the command modifier for the separator token in the global variable -|last_add_type|. We must be careful because this variable might get overwritten -any time we call |get_x_next|. - -@<Glob...@>= -quarterword last_add_type; - /* command modifier that identifies the last \&{addto} command */ - -@ @<Declare action procedures for use by |do_statement|@>= -static pointer mp_start_draw_cmd (MP mp,quarterword sep) ; - -@ @c pointer mp_start_draw_cmd (MP mp,quarterword sep) { - pointer lhv; /* variable to add to left */ - quarterword add_type=0; /* value to be returned in |last_add_type| */ - lhv=null; - mp_get_x_next(mp); mp->var_flag=sep; mp_scan_primary(mp); - if ( mp->cur_type!=mp_token_list ) { - @<Abandon edges command because there's no variable@>; - } else { - lhv=mp->cur_exp; add_type=mp->cur_mod; - mp->cur_type=mp_vacuous; mp_get_x_next(mp); mp_scan_expression(mp); - } - mp->last_add_type=add_type; - return lhv; -} - -@ @<Abandon edges command because there's no variable@>= -{ exp_err("Not a suitable variable"); -@.Not a suitable variable@> - help4("At this point I needed to see the name of a picture variable.", - "(Or perhaps you have indeed presented me with one; I might", - "have missed it, if it wasn't followed by the proper token.)", - "So I'll not change anything just now."); - mp_put_get_flush_error(mp, 0); -} - -@ Here is an example of how to use |start_draw_cmd|. - -@<Declare action procedures for use by |do_statement|@>= -static void mp_do_bounds (MP mp) ; - -@ @c void mp_do_bounds (MP mp) { - pointer lhv,lhe; /* variable on left, the corresponding edge structure */ - pointer p; /* for list manipulation */ - integer m; /* initial value of |cur_mod| */ - m=mp->cur_mod; - lhv=mp_start_draw_cmd(mp, to_token); - if ( lhv!=null ) { - lhe=mp_find_edges_var(mp, lhv); - if ( lhe==null ) { - mp_flush_cur_exp(mp, 0); - } else if ( mp->cur_type!=mp_path_type ) { - exp_err("Improper `clip'"); -@.Improper `addto'@> - help2("This expression should have specified a known path.", - "So I'll not change anything just now."); - mp_put_get_flush_error(mp, 0); - } else if ( mp_left_type(mp->cur_exp)==mp_endpoint ) { - @<Complain about a non-cycle@>; - } else { - @<Make |cur_exp| into a \&{setbounds} or clipping path and add it to |lhe|@>; - } - } -} - -@ @<Complain about a non-cycle@>= -{ print_err("Not a cycle"); -@.Not a cycle@> - help2("That contour should have ended with `..cycle' or `&cycle'.", - "So I'll not change anything just now."); mp_put_get_error(mp); -} - -@ @<Make |cur_exp| into a \&{setbounds} or clipping path and add...@>= -{ p=mp_new_bounds_node(mp, mp->cur_exp,m); - mp_link(p)=mp_link(dummy_loc(lhe)); - mp_link(dummy_loc(lhe))=p; - if ( obj_tail(lhe)==dummy_loc(lhe) ) obj_tail(lhe)=p; - p=mp_get_node(mp, mp->gr_object_size[stop_type(m)]); - mp_type(p)=stop_type(m); - mp_link(obj_tail(lhe))=p; - obj_tail(lhe)=p; - mp_init_bbox(mp, lhe); -} - -@ The |do_add_to| procedure is a little like |do_clip| but there are a lot more -cases to deal with. - -@<Declare action procedures for use by |do_statement|@>= -static void mp_do_add_to (MP mp) ; - -@ @c void mp_do_add_to (MP mp) { - pointer lhv,lhe; /* variable on left, the corresponding edge structure */ - pointer p; /* the graphical object or list for |scan_with_list| to update */ - pointer e; /* an edge structure to be merged */ - quarterword add_type; /* |also_code|, |contour_code|, or |double_path_code| */ - lhv=mp_start_draw_cmd(mp, thing_to_add); add_type=mp->last_add_type; - if ( lhv!=null ) { - if ( add_type==also_code ) { - @<Make sure the current expression is a suitable picture and set |e| and |p| - appropriately@>; - } else { - @<Create a graphical object |p| based on |add_type| and the current - expression@>; - } - mp_scan_with_list(mp, p); - @<Use |p|, |e|, and |add_type| to augment |lhv| as requested@>; - } -} - -@ Setting |p:=null| causes the $\langle$with list$\rangle$ to be ignored; -setting |e:=null| prevents anything from being added to |lhe|. - -@ @<Make sure the current expression is a suitable picture and set |e|...@>= -{ - p=null; e=null; - if ( mp->cur_type!=mp_picture_type ) { - exp_err("Improper `addto'"); -@.Improper `addto'@> - help2("This expression should have specified a known picture.", - "So I'll not change anything just now."); - mp_put_get_flush_error(mp, 0); - } else { - e=mp_private_edges(mp, mp->cur_exp); mp->cur_type=mp_vacuous; - p=mp_link(dummy_loc(e)); - } -} - -@ In this case |add_type<>also_code| so setting |p:=null| suppresses future -attempts to add to the edge structure. - -@<Create a graphical object |p| based on |add_type| and the current...@>= -{ e=null; p=null; - if ( mp->cur_type==mp_pair_type ) mp_pair_to_path(mp); - if ( mp->cur_type!=mp_path_type ) { - exp_err("Improper `addto'"); -@.Improper `addto'@> - help2("This expression should have specified a known path.", - "So I'll not change anything just now."); - mp_put_get_flush_error(mp, 0); - } else if ( add_type==contour_code ) { - if ( mp_left_type(mp->cur_exp)==mp_endpoint ) { - @<Complain about a non-cycle@>; - } else { - p=mp_new_fill_node(mp, mp->cur_exp); - mp->cur_type=mp_vacuous; - } - } else { - p=mp_new_stroked_node(mp, mp->cur_exp); - mp->cur_type=mp_vacuous; - } -} - -@ @<Use |p|, |e|, and |add_type| to augment |lhv| as requested@>= -lhe=mp_find_edges_var(mp, lhv); -if ( lhe==null ) { - if ( (e==null)&&(p!=null) ) e=mp_toss_gr_object(mp, p); - if ( e!=null ) delete_edge_ref(e); -} else if ( add_type==also_code ) { - if ( e!=null ) { - @<Merge |e| into |lhe| and delete |e|@>; - } else { - do_nothing; - } -} else if ( p!=null ) { - mp_link(obj_tail(lhe))=p; - obj_tail(lhe)=p; - if ( add_type==double_path_code ) - if ( mp_pen_p(p)==null ) - mp_pen_p(p)=mp_get_pen_circle(mp, 0); -} - -@ @<Merge |e| into |lhe| and delete |e|@>= -{ if ( mp_link(dummy_loc(e))!=null ) { - mp_link(obj_tail(lhe))=mp_link(dummy_loc(e)); - obj_tail(lhe)=obj_tail(e); - obj_tail(e)=dummy_loc(e); - mp_link(dummy_loc(e))=null; - mp_flush_dash_list(mp, lhe); - } - mp_toss_edges(mp, e); -} - -@ @<Cases of |do_statement|...@>= -case ship_out_command: mp_do_ship_out(mp); break; - -@ @<Declare action procedures for use by |do_statement|@>= -@<Declare the \ps\ output procedures@> -static void mp_do_ship_out (MP mp) ; - -@ @c void mp_do_ship_out (MP mp) { - integer c; /* the character code */ - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type!=mp_picture_type ) { - @<Complain that it's not a known picture@>; - } else { - c=mp_round_unscaled(mp, mp->internal[mp_char_code]) % 256; - if ( c<0 ) c=c+256; - @<Store the width information for character code~|c|@>; - mp_ship_out(mp, mp->cur_exp); - mp_flush_cur_exp(mp, 0); - } -} - -@ @<Complain that it's not a known picture@>= -{ - exp_err("Not a known picture"); - help1("I can only output known pictures."); - mp_put_get_flush_error(mp, 0); -} - -@ The \&{everyjob} command simply assigns a nonzero value to the global variable -|start_sym|. - -@<Cases of |do_statement|...@>= -case every_job_command: - mp_get_symbol(mp); mp->start_sym=mp->cur_sym; mp_get_x_next(mp); - break; - -@ @<Glob...@>= -halfword start_sym; /* a symbolic token to insert at beginning of job */ - -@ @<Set init...@>= -mp->start_sym=0; - -@ Finally, we have only the ``message'' commands remaining. - -@d message_code 0 -@d err_message_code 1 -@d err_help_code 2 -@d filename_template_code 3 -@d print_with_leading_zeroes(A) g = mp->pool_ptr; - mp_print_int(mp, (A)); g = mp->pool_ptr-g; - if ( f>g ) { - mp->pool_ptr = mp->pool_ptr - g; - while ( f>g ) { - mp_print_char(mp, xord('0')); - decr(f); - }; - mp_print_int(mp, (A)); - }; - f = 0 - -@<Put each...@>= -mp_primitive(mp, "message",message_command,message_code); -@:message_}{\&{message} primitive@> -mp_primitive(mp, "errmessage",message_command,err_message_code); -@:err_message_}{\&{errmessage} primitive@> -mp_primitive(mp, "errhelp",message_command,err_help_code); -@:err_help_}{\&{errhelp} primitive@> -mp_primitive(mp, "filenametemplate",message_command,filename_template_code); -@:filename_template_}{\&{filenametemplate} primitive@> - -@ @<Cases of |print_cmd...@>= -case message_command: - if ( m<err_message_code ) mp_print(mp, "message"); - else if ( m==err_message_code ) mp_print(mp, "errmessage"); - else if ( m==filename_template_code ) mp_print(mp, "filenametemplate"); - else mp_print(mp, "errhelp"); - break; - -@ @<Cases of |do_statement|...@>= -case message_command: mp_do_message(mp); break; - -@ @<Declare action procedures for use by |do_statement|@>= -@<Declare a procedure called |no_string_err|@> -static void mp_do_message (MP mp) ; - -@ -@c void mp_do_message (MP mp) { - int m; /* the type of message */ - m=mp->cur_mod; mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type!=mp_string_type ) - mp_no_string_err(mp, "A message should be a known string expression."); - else { - switch (m) { - case message_code: - mp_print_nl(mp, ""); mp_print_str(mp, mp->cur_exp); - break; - case err_message_code: - @<Print string |cur_exp| as an error message@>; - break; - case err_help_code: - @<Save string |cur_exp| as the |err_help|@>; - break; - case filename_template_code: - @<Save the filename template@>; - break; - } /* there are no other cases */ - } - mp_flush_cur_exp(mp, 0); -} - -@ @<Declare a procedure called |no_string_err|@>= -static void mp_no_string_err (MP mp, const char *s) { - exp_err("Not a string"); -@.Not a string@> - help1(s); - mp_put_get_error(mp); -} - -@ The global variable |err_help| is zero when the user has most recently -given an empty help string, or if none has ever been given. - -@<Save string |cur_exp| as the |err_help|@>= -{ - if ( mp->err_help!=0 ) delete_str_ref(mp->err_help); - if ( length(mp->cur_exp)==0 ) mp->err_help=0; - else { mp->err_help=mp->cur_exp; add_str_ref(mp->err_help); } -} - -@ If \&{errmessage} occurs often in |mp_scroll_mode|, without user-defined -\&{errhelp}, we don't want to give a long help message each time. So we -give a verbose explanation only once. - -@<Glob...@>= -boolean long_help_seen; /* has the long \.{\\errmessage} help been used? */ - -@ @<Set init...@>=mp->long_help_seen=false; - -@ @<Print string |cur_exp| as an error message@>= -{ - print_err(""); mp_print_str(mp, mp->cur_exp); - if ( mp->err_help!=0 ) { - mp->use_err_help=true; - } else if ( mp->long_help_seen ) { - help1("(That was another `errmessage'.)") ; - } else { - if ( mp->interaction<mp_error_stop_mode ) mp->long_help_seen=true; - help4("This error message was generated by an `errmessage'", - "command, so I can\'t give any explicit help.", - "Pretend that you're Miss Marple: Examine all clues,", -@^Marple, Jane@> - "and deduce the truth by inspired guesses."); - } - mp_put_get_error(mp); mp->use_err_help=false; -} - -@ @<Cases of |do_statement|...@>= -case write_command: mp_do_write(mp); break; - -@ @<Declare action procedures for use by |do_statement|@>= -static void mp_do_write (MP mp) ; - -@ @c void mp_do_write (MP mp) { - str_number t; /* the line of text to be written */ - write_index n,n0; /* for searching |wr_fname| and |wr_file| arrays */ - unsigned old_setting; /* for saving |selector| during output */ - mp_get_x_next(mp); - mp_scan_expression(mp); - if ( mp->cur_type!=mp_string_type ) { - mp_no_string_err(mp, "The text to be written should be a known string expression"); - } else if ( mp->cur_cmd!=to_token ) { - print_err("Missing `to' clause"); - help1("A write command should end with `to <filename>'"); - mp_put_get_error(mp); - } else { - t=mp->cur_exp; mp->cur_type=mp_vacuous; - mp_get_x_next(mp); - mp_scan_expression(mp); - if ( mp->cur_type!=mp_string_type ) - mp_no_string_err(mp, "I can\'t write to that file name. It isn't a known string"); - else { - @<Write |t| to the file named by |cur_exp|@>; - } - delete_str_ref(t); - } - mp_flush_cur_exp(mp, 0); -} - -@ @<Write |t| to the file named by |cur_exp|@>= -{ - @<Find |n| where |wr_fname[n]=cur_exp| and call |open_write_file| if - |cur_exp| must be inserted@>; - if ( mp_str_vs_str(mp, t,mp->eof_line)==0 ) { - @<Record the end of file on |wr_file[n]|@>; - } else { - old_setting=mp->selector; - mp->selector=n+write_file; - mp_print_str(mp, t); mp_print_ln(mp); - mp->selector = old_setting; - } -} - -@ @<Find |n| where |wr_fname[n]=cur_exp| and call |open_write_file| if...@>= -{ - char *fn = str(mp->cur_exp); - n=mp->write_files; - n0=mp->write_files; - while (mp_xstrcmp(fn,mp->wr_fname[n])!=0) { - if ( n==0 ) { /* bottom reached */ - if ( n0==mp->write_files ) { - if ( mp->write_files<mp->max_write_files ) { - incr(mp->write_files); - } else { - void **wr_file; - char **wr_fname; - write_index l,k; - l = mp->max_write_files + (mp->max_write_files/4); - wr_file = xmalloc((l+1),sizeof(void *)); - wr_fname = xmalloc((l+1),sizeof(char *)); - for (k=0;k<=l;k++) { - if (k<=mp->max_write_files) { - wr_file[k]=mp->wr_file[k]; - wr_fname[k]=mp->wr_fname[k]; - } else { - wr_file[k]=0; - wr_fname[k]=NULL; - } - } - xfree(mp->wr_file); xfree(mp->wr_fname); - mp->max_write_files = l; - mp->wr_file = wr_file; - mp->wr_fname = wr_fname; - } - } - n=n0; - mp_open_write_file(mp, fn ,n); - } else { - decr(n); - if ( mp->wr_fname[n]==NULL ) n0=n; - } - } -} - -@ @<Record the end of file on |wr_file[n]|@>= -{ (mp->close_file)(mp,mp->wr_file[n]); - xfree(mp->wr_fname[n]); - if ( n==mp->write_files-1 ) mp->write_files=n; -} - - -@* \[42] Writing font metric data. -\TeX\ gets its knowledge about fonts from font metric files, also called -\.{TFM} files; the `\.T' in `\.{TFM}' stands for \TeX, -but other programs know about them too. One of \MP's duties is to -write \.{TFM} files so that the user's fonts can readily be -applied to typesetting. -@:TFM files}{\.{TFM} files@> -@^font metric files@> - -The information in a \.{TFM} file appears in a sequence of 8-bit bytes. -Since the number of bytes is always a multiple of~4, we could -also regard the file as a sequence of 32-bit words, but \MP\ uses the -byte interpretation. The format of \.{TFM} files was designed by -Lyle Ramshaw in 1980. The intent is to convey a lot of different kinds -@^Ramshaw, Lyle Harold@> -of information in a compact but useful form. - -@<Glob...@>= -void * tfm_file; /* the font metric output goes here */ -char * metric_file_name; /* full name of the font metric file */ - -@ The first 24 bytes (6 words) of a \.{TFM} file contain twelve 16-bit -integers that give the lengths of the various subsequent portions -of the file. These twelve integers are, in order: -$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr -|lf|&length of the entire file, in words;\cr -|lh|&length of the header data, in words;\cr -|bc|&smallest character code in the font;\cr -|ec|&largest character code in the font;\cr -|nw|&number of words in the width table;\cr -|nh|&number of words in the height table;\cr -|nd|&number of words in the depth table;\cr -|ni|&number of words in the italic correction table;\cr -|nl|&number of words in the lig/kern table;\cr -|nk|&number of words in the kern table;\cr -|ne|&number of words in the extensible character table;\cr -|np|&number of font parameter words.\cr}}$$ -They are all nonnegative and less than $2^{15}$. We must have |bc-1<=ec<=255|, -|ne<=256|, and -$$\hbox{|lf=6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$ -Note that a font may contain as many as 256 characters (if |bc=0| and |ec=255|), -and as few as 0 characters (if |bc=ec+1|). - -Incidentally, when two or more 8-bit bytes are combined to form an integer of -16 or more bits, the most significant bytes appear first in the file. -This is called BigEndian order. -@^BigEndian order@> - -@ The rest of the \.{TFM} file may be regarded as a sequence of ten data -arrays. - -The most important data type used here is a |fix_word|, which is -a 32-bit representation of a binary fraction. A |fix_word| is a signed -quantity, with the two's complement of the entire word used to represent -negation. Of the 32 bits in a |fix_word|, exactly 12 are to the left of the -binary point; thus, the largest |fix_word| value is $2048-2^{-20}$, and -the smallest is $-2048$. We will see below, however, that all but two of -the |fix_word| values must lie between $-16$ and $+16$. - -@ The first data array is a block of header information, which contains -general facts about the font. The header must contain at least two words, -|header[0]| and |header[1]|, whose meaning is explained below. Additional -header information of use to other software routines might also be -included, and \MP\ will generate it if the \.{headerbyte} command occurs. -For example, 16 more words of header information are in use at the Xerox -Palo Alto Research Center; the first ten specify the character coding -scheme used (e.g., `\.{XEROX TEXT}' or `\.{TEX MATHSY}'), the next five -give the font family name (e.g., `\.{HELVETICA}' or `\.{CMSY}'), and the -last gives the ``face byte.'' - -\yskip\hang|header[0]| is a 32-bit check sum that \MP\ will copy into -the \.{GF} output file. This helps ensure consistency between files, -since \TeX\ records the check sums from the \.{TFM}'s it reads, and these -should match the check sums on actual fonts that are used. The actual -relation between this check sum and the rest of the \.{TFM} file is not -important; the check sum is simply an identification number with the -property that incompatible fonts almost always have distinct check sums. -@^check sum@> - -\yskip\hang|header[1]| is a |fix_word| containing the design size of the -font, in units of \TeX\ points. This number must be at least 1.0; it is -fairly arbitrary, but usually the design size is 10.0 for a ``10 point'' -font, i.e., a font that was designed to look best at a 10-point size, -whatever that really means. When a \TeX\ user asks for a font `\.{at} -$\delta$ \.{pt}', the effect is to override the design size and replace it -by $\delta$, and to multiply the $x$ and~$y$ coordinates of the points in -the font image by a factor of $\delta$ divided by the design size. {\sl -All other dimensions in the\/ \.{TFM} file are |fix_word|\kern-1pt\ -numbers in design-size units.} Thus, for example, the value of |param[6]|, -which defines the \.{em} unit, is often the |fix_word| value $2^{20}=1.0$, -since many fonts have a design size equal to one em. The other dimensions -must be less than 16 design-size units in absolute value; thus, -|header[1]| and |param[1]| are the only |fix_word| entries in the whole -\.{TFM} file whose first byte might be something besides 0 or 255. -@^design size@> - -@ Next comes the |char_info| array, which contains one |char_info_word| -per character. Each word in this part of the file contains six fields -packed into four bytes as follows. - -\yskip\hang first byte: |width_index| (8 bits)\par -\hang second byte: |height_index| (4 bits) times 16, plus |depth_index| - (4~bits)\par -\hang third byte: |italic_index| (6 bits) times 4, plus |tag| - (2~bits)\par -\hang fourth byte: |remainder| (8 bits)\par -\yskip\noindent -The actual width of a character is \\{width}|[width_index]|, in design-size -units; this is a device for compressing information, since many characters -have the same width. Since it is quite common for many characters -to have the same height, depth, or italic correction, the \.{TFM} format -imposes a limit of 16 different heights, 16 different depths, and -64 different italic corrections. - -Incidentally, the relation $\\{width}[0]=\\{height}[0]=\\{depth}[0]= -\\{italic}[0]=0$ should always hold, so that an index of zero implies a -value of zero. The |width_index| should never be zero unless the -character does not exist in the font, since a character is valid if and -only if it lies between |bc| and |ec| and has a nonzero |width_index|. - -@ The |tag| field in a |char_info_word| has four values that explain how to -interpret the |remainder| field. - -\yskip\hang|tag=0| (|no_tag|) means that |remainder| is unused.\par -\hang|tag=1| (|lig_tag|) means that this character has a ligature/kerning -program starting at location |remainder| in the |lig_kern| array.\par -\hang|tag=2| (|list_tag|) means that this character is part of a chain of -characters of ascending sizes, and not the largest in the chain. The -|remainder| field gives the character code of the next larger character.\par -\hang|tag=3| (|ext_tag|) means that this character code represents an -extensible character, i.e., a character that is built up of smaller pieces -so that it can be made arbitrarily large. The pieces are specified in -|exten[remainder]|.\par -\yskip\noindent -Characters with |tag=2| and |tag=3| are treated as characters with |tag=0| -unless they are used in special circumstances in math formulas. For example, -\TeX's \.{\\sum} operation looks for a |list_tag|, and the \.{\\left} -operation looks for both |list_tag| and |ext_tag|. - -@d no_tag 0 /* vanilla character */ -@d lig_tag 1 /* character has a ligature/kerning program */ -@d list_tag 2 /* character has a successor in a charlist */ -@d ext_tag 3 /* character is extensible */ - -@ The |lig_kern| array contains instructions in a simple programming language -that explains what to do for special letter pairs. Each word in this array is a -|lig_kern_command| of four bytes. - -\yskip\hang first byte: |skip_byte|, indicates that this is the final program - step if the byte is 128 or more, otherwise the next step is obtained by - skipping this number of intervening steps.\par -\hang second byte: |next_char|, ``if |next_char| follows the current character, - then perform the operation and stop, otherwise continue.''\par -\hang third byte: |op_byte|, indicates a ligature step if less than~128, - a kern step otherwise.\par -\hang fourth byte: |remainder|.\par -\yskip\noindent -In a kern step, an -additional space equal to |kern[256*(op_byte-128)+remainder]| is inserted -between the current character and |next_char|. This amount is -often negative, so that the characters are brought closer together -by kerning; but it might be positive. - -There are eight kinds of ligature steps, having |op_byte| codes $4a+2b+c$ where -$0\le a\le b+c$ and $0\le b,c\le1$. The character whose code is -|remainder| is inserted between the current character and |next_char|; -then the current character is deleted if $b=0$, and |next_char| is -deleted if $c=0$; then we pass over $a$~characters to reach the next -current character (which may have a ligature/kerning program of its own). - -If the very first instruction of the |lig_kern| array has |skip_byte=255|, -the |next_char| byte is the so-called right boundary character of this font; -the value of |next_char| need not lie between |bc| and~|ec|. -If the very last instruction of the |lig_kern| array has |skip_byte=255|, -there is a special ligature/kerning program for a left boundary character, -beginning at location |256*op_byte+remainder|. -The interpretation is that \TeX\ puts implicit boundary characters -before and after each consecutive string of characters from the same font. -These implicit characters do not appear in the output, but they can affect -ligatures and kerning. - -If the very first instruction of a character's |lig_kern| program has -|skip_byte>128|, the program actually begins in location -|256*op_byte+remainder|. This feature allows access to large |lig_kern| -arrays, because the first instruction must otherwise -appear in a location |<=255|. - -Any instruction with |skip_byte>128| in the |lig_kern| array must satisfy -the condition -$$\hbox{|256*op_byte+remainder<nl|.}$$ -If such an instruction is encountered during -normal program execution, it denotes an unconditional halt; no ligature -command is performed. - -@d stop_flag (128) - /* value indicating `\.{STOP}' in a lig/kern program */ -@d kern_flag (128) /* op code for a kern step */ -@d skip_byte(A) mp->lig_kern[(A)].b0 -@d next_char(A) mp->lig_kern[(A)].b1 -@d op_byte(A) mp->lig_kern[(A)].b2 -@d rem_byte(A) mp->lig_kern[(A)].b3 - -@ Extensible characters are specified by an |extensible_recipe|, which -consists of four bytes called |top|, |mid|, |bot|, and |rep| (in this -order). These bytes are the character codes of individual pieces used to -build up a large symbol. If |top|, |mid|, or |bot| are zero, they are not -present in the built-up result. For example, an extensible vertical line is -like an extensible bracket, except that the top and bottom pieces are missing. - -Let $T$, $M$, $B$, and $R$ denote the respective pieces, or an empty box -if the piece isn't present. Then the extensible characters have the form -$TR^kMR^kB$ from top to bottom, for some |k>=0|, unless $M$ is absent; -in the latter case we can have $TR^kB$ for both even and odd values of~|k|. -The width of the extensible character is the width of $R$; and the -height-plus-depth is the sum of the individual height-plus-depths of the -components used, since the pieces are butted together in a vertical list. - -@d ext_top(A) mp->exten[(A)].b0 /* |top| piece in a recipe */ -@d ext_mid(A) mp->exten[(A)].b1 /* |mid| piece in a recipe */ -@d ext_bot(A) mp->exten[(A)].b2 /* |bot| piece in a recipe */ -@d ext_rep(A) mp->exten[(A)].b3 /* |rep| piece in a recipe */ - -@ The final portion of a \.{TFM} file is the |param| array, which is another -sequence of |fix_word| values. - -\yskip\hang|param[1]=slant| is the amount of italic slant, which is used -to help position accents. For example, |slant=.25| means that when you go -up one unit, you also go .25 units to the right. The |slant| is a pure -number; it is the only |fix_word| other than the design size itself that is -not scaled by the design size. -@^design size@> - -\hang|param[2]=space| is the normal spacing between words in text. -Note that character 040 in the font need not have anything to do with -blank spaces. - -\hang|param[3]=space_stretch| is the amount of glue stretching between words. - -\hang|param[4]=space_shrink| is the amount of glue shrinking between words. - -\hang|param[5]=x_height| is the size of one ex in the font; it is also -the height of letters for which accents don't have to be raised or lowered. - -\hang|param[6]=quad| is the size of one em in the font. - -\hang|param[7]=extra_space| is the amount added to |param[2]| at the -ends of sentences. - -\yskip\noindent -If fewer than seven parameters are present, \TeX\ sets the missing parameters -to zero. - -@d slant_code 1 -@d space_code 2 -@d space_stretch_code 3 -@d space_shrink_code 4 -@d x_height_code 5 -@d quad_code 6 -@d extra_space_code 7 - -@ So that is what \.{TFM} files hold. One of \MP's duties is to output such -information, and it does this all at once at the end of a job. -In order to prepare for such frenetic activity, it squirrels away the -necessary facts in various arrays as information becomes available. - -Character dimensions (\&{charwd}, \&{charht}, \&{chardp}, and \&{charic}) -are stored respectively in |tfm_width|, |tfm_height|, |tfm_depth|, and -|tfm_ital_corr|. Other information about a character (e.g., about -its ligatures or successors) is accessible via the |char_tag| and -|char_remainder| arrays. Other information about the font as a whole -is kept in additional arrays called |header_byte|, |lig_kern|, -|kern|, |exten|, and |param|. - -@d max_tfm_int 32510 -@d undefined_label max_tfm_int /* an undefined local label */ - -@<Glob...@>= -#define TFM_ITEMS 257 -eight_bits bc; -eight_bits ec; /* smallest and largest character codes shipped out */ -scaled tfm_width[TFM_ITEMS]; /* \&{charwd} values */ -scaled tfm_height[TFM_ITEMS]; /* \&{charht} values */ -scaled tfm_depth[TFM_ITEMS]; /* \&{chardp} values */ -scaled tfm_ital_corr[TFM_ITEMS]; /* \&{charic} values */ -boolean char_exists[TFM_ITEMS]; /* has this code been shipped out? */ -int char_tag[TFM_ITEMS]; /* |remainder| category */ -int char_remainder[TFM_ITEMS]; /* the |remainder| byte */ -char *header_byte; /* bytes of the \.{TFM} header */ -int header_last; /* last initialized \.{TFM} header byte */ -int header_size; /* size of the \.{TFM} header */ -four_quarters *lig_kern; /* the ligature/kern table */ -short nl; /* the number of ligature/kern steps so far */ -scaled *kern; /* distinct kerning amounts */ -short nk; /* the number of distinct kerns so far */ -four_quarters exten[TFM_ITEMS]; /* extensible character recipes */ -short ne; /* the number of extensible characters so far */ -scaled *param; /* \&{fontinfo} parameters */ -short np; /* the largest \&{fontinfo} parameter specified so far */ -short nw;short nh;short nd;short ni; /* sizes of \.{TFM} subtables */ -short skip_table[TFM_ITEMS]; /* local label status */ -boolean lk_started; /* has there been a lig/kern step in this command yet? */ -integer bchar; /* right boundary character */ -short bch_label; /* left boundary starting location */ -short ll;short lll; /* registers used for lig/kern processing */ -short label_loc[257]; /* lig/kern starting addresses */ -eight_bits label_char[257]; /* characters for |label_loc| */ -short label_ptr; /* highest position occupied in |label_loc| */ - -@ @<Allocate or initialize ...@>= -mp->header_last=7; -mp->header_size = 128; /* just for init */ -mp->header_byte = xmalloc(mp->header_size, sizeof(char)); - -@ @<Dealloc variables@>= -xfree(mp->header_byte); -xfree(mp->lig_kern); -xfree(mp->kern); -xfree(mp->param); - -@ @<Set init...@>= -for (k=0;k<= 255;k++ ) { - mp->tfm_width[k]=0; mp->tfm_height[k]=0; mp->tfm_depth[k]=0; mp->tfm_ital_corr[k]=0; - mp->char_exists[k]=false; mp->char_tag[k]=no_tag; mp->char_remainder[k]=0; - mp->skip_table[k]=undefined_label; -} -memset(mp->header_byte,0,(size_t)mp->header_size); -mp->bc=255; mp->ec=0; mp->nl=0; mp->nk=0; mp->ne=0; mp->np=0; -mp->internal[mp_boundary_char]=-unity; -mp->bch_label=undefined_label; -mp->label_loc[0]=-1; mp->label_ptr=0; - -@ @<Declarations@>= -static scaled mp_tfm_check (MP mp,quarterword m) ; - -@ @c -static scaled mp_tfm_check (MP mp,quarterword m) { - if ( abs(mp->internal[m])>=fraction_half ) { - print_err("Enormous "); mp_print(mp, mp->int_name[m]); -@.Enormous charwd...@> -@.Enormous chardp...@> -@.Enormous charht...@> -@.Enormous charic...@> -@.Enormous designsize...@> - mp_print(mp, " has been reduced"); - help1("Font metric dimensions must be less than 2048pt."); - mp_put_get_error(mp); - if ( mp->internal[m]>0 ) return (fraction_half-1); - else return (1-fraction_half); - } else { - return mp->internal[m]; - } -} - -@ @<Store the width information for character code~|c|@>= -if ( c<mp->bc ) mp->bc=(eight_bits)c; -if ( c>mp->ec ) mp->ec=(eight_bits)c; -mp->char_exists[c]=true; -mp->tfm_width[c]=mp_tfm_check(mp,mp_char_wd); -mp->tfm_height[c]=mp_tfm_check(mp, mp_char_ht); -mp->tfm_depth[c]=mp_tfm_check(mp, mp_char_dp); -mp->tfm_ital_corr[c]=mp_tfm_check(mp, mp_char_ic) - -@ Now let's consider \MP's special \.{TFM}-oriented commands. - -@<Cases of |do_statement|...@>= -case tfm_command: mp_do_tfm_command(mp); break; - -@ @d char_list_code 0 -@d lig_table_code 1 -@d extensible_code 2 -@d header_byte_code 3 -@d font_dimen_code 4 - -@<Put each...@>= -mp_primitive(mp, "charlist",tfm_command,char_list_code); -@:char_list_}{\&{charlist} primitive@> -mp_primitive(mp, "ligtable",tfm_command,lig_table_code); -@:lig_table_}{\&{ligtable} primitive@> -mp_primitive(mp, "extensible",tfm_command,extensible_code); -@:extensible_}{\&{extensible} primitive@> -mp_primitive(mp, "headerbyte",tfm_command,header_byte_code); -@:header_byte_}{\&{headerbyte} primitive@> -mp_primitive(mp, "fontdimen",tfm_command,font_dimen_code); -@:font_dimen_}{\&{fontdimen} primitive@> - -@ @<Cases of |print_cmd...@>= -case tfm_command: - switch (m) { - case char_list_code:mp_print(mp, "charlist"); break; - case lig_table_code:mp_print(mp, "ligtable"); break; - case extensible_code:mp_print(mp, "extensible"); break; - case header_byte_code:mp_print(mp, "headerbyte"); break; - default: mp_print(mp, "fontdimen"); break; - } - break; - -@ @<Declare action procedures for use by |do_statement|@>= -static eight_bits mp_get_code (MP mp) ; - -@ @c eight_bits mp_get_code (MP mp) { /* scans a character code value */ - integer c; /* the code value found */ - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type==mp_known ) { - c=mp_round_unscaled(mp, mp->cur_exp); - if ( c>=0 ) if ( c<256 ) return (eight_bits)c; - } else if ( mp->cur_type==mp_string_type ) { - if ( length(mp->cur_exp)==1 ) { - c=mp->str_pool[mp->str_start[mp->cur_exp]]; - return (eight_bits)c; - } - } - exp_err("Invalid code has been replaced by 0"); -@.Invalid code...@> - help2("I was looking for a number between 0 and 255, or for a", - "string of length 1. Didn't find it; will use 0 instead."); - mp_put_get_flush_error(mp, 0); c=0; - return (eight_bits)c; -} - -@ @<Declare action procedures for use by |do_statement|@>= -static void mp_set_tag (MP mp,halfword c, quarterword t, halfword r) ; - -@ @c void mp_set_tag (MP mp,halfword c, quarterword t, halfword r) { - if ( mp->char_tag[c]==no_tag ) { - mp->char_tag[c]=t; mp->char_remainder[c]=r; - if ( t==lig_tag ){ - incr(mp->label_ptr); mp->label_loc[mp->label_ptr]=r; - mp->label_char[mp->label_ptr]=(eight_bits)c; - } - } else { - @<Complain about a character tag conflict@>; - } -} - -@ @<Complain about a character tag conflict@>= -{ - print_err("Character "); - if ( (c>' ')&&(c<127) ) mp_print_char(mp,xord(c)); - else if ( c==256 ) mp_print(mp, "||"); - else { mp_print(mp, "code "); mp_print_int(mp, c); }; - mp_print(mp, " is already "); -@.Character c is already...@> - switch (mp->char_tag[c]) { - case lig_tag: mp_print(mp, "in a ligtable"); break; - case list_tag: mp_print(mp, "in a charlist"); break; - case ext_tag: mp_print(mp, "extensible"); break; - } /* there are no other cases */ - help2("It's not legal to label a character more than once.", - "So I'll not change anything just now."); - mp_put_get_error(mp); -} - -@ @<Declare action procedures for use by |do_statement|@>= -static void mp_do_tfm_command (MP mp) ; - -@ @c void mp_do_tfm_command (MP mp) { - int c,cc; /* character codes */ - int k; /* index into the |kern| array */ - int j; /* index into |header_byte| or |param| */ - switch (mp->cur_mod) { - case char_list_code: - c=mp_get_code(mp); - /* we will store a list of character successors */ - while ( mp->cur_cmd==colon ) { - cc=mp_get_code(mp); mp_set_tag(mp, c,list_tag,cc); c=cc; - }; - break; - case lig_table_code: - if (mp->lig_kern==NULL) - mp->lig_kern = xmalloc((max_tfm_int+1),sizeof(four_quarters)); - if (mp->kern==NULL) - mp->kern = xmalloc((max_tfm_int+1),sizeof(scaled)); - @<Store a list of ligature/kern steps@>; - break; - case extensible_code: - @<Define an extensible recipe@>; - break; - case header_byte_code: - case font_dimen_code: - c=mp->cur_mod; mp_get_x_next(mp); - mp_scan_expression(mp); - if ( (mp->cur_type!=mp_known)||(mp->cur_exp<half_unit) ) { - exp_err("Improper location"); -@.Improper location@> - help2("I was looking for a known, positive number.", - "For safety's sake I'll ignore the present command."); - mp_put_get_error(mp); - } else { - j=mp_round_unscaled(mp, mp->cur_exp); - if ( mp->cur_cmd!=colon ) { - mp_missing_err(mp, ":"); -@.Missing `:'@> - help1("A colon should follow a headerbyte or fontinfo location."); - mp_back_error(mp); - } - if ( c==header_byte_code ) { - @<Store a list of header bytes@>; - } else { - if (mp->param==NULL) - mp->param = xmalloc((max_tfm_int+1),sizeof(scaled)); - @<Store a list of font dimensions@>; - } - } - break; - } /* there are no other cases */ -} - -@ @<Store a list of ligature/kern steps@>= -{ - mp->lk_started=false; -CONTINUE: - mp_get_x_next(mp); - if ((mp->cur_cmd==skip_to)&& mp->lk_started ) - @<Process a |skip_to| command and |goto done|@>; - if ( mp->cur_cmd==bchar_label ) { c=256; mp->cur_cmd=colon; } - else { mp_back_input(mp); c=mp_get_code(mp); }; - if ((mp->cur_cmd==colon)||(mp->cur_cmd==double_colon)) { - @<Record a label in a lig/kern subprogram and |goto continue|@>; - } - if ( mp->cur_cmd==lig_kern_token ) { - @<Compile a ligature/kern command@>; - } else { - print_err("Illegal ligtable step"); -@.Illegal ligtable step@> - help1("I was looking for `=:' or `kern' here."); - mp_back_error(mp); next_char(mp->nl)=qi(0); - op_byte(mp->nl)=qi(0); rem_byte(mp->nl)=qi(0); - skip_byte(mp->nl)=stop_flag+1; /* this specifies an unconditional stop */ - } - if ( mp->nl==max_tfm_int) mp_fatal_error(mp, "ligtable too large"); - incr(mp->nl); - if ( mp->cur_cmd==comma ) goto CONTINUE; - if ( skip_byte(mp->nl-1)<stop_flag ) skip_byte(mp->nl-1)=stop_flag; -} -DONE: - -@ @<Put each...@>= -mp_primitive(mp, "=:",lig_kern_token,0); -@:=:_}{\.{=:} primitive@> -mp_primitive(mp, "=:|",lig_kern_token,1); -@:=:/_}{\.{=:\char'174} primitive@> -mp_primitive(mp, "=:|>",lig_kern_token,5); -@:=:/>_}{\.{=:\char'174>} primitive@> -mp_primitive(mp, "|=:",lig_kern_token,2); -@:=:/_}{\.{\char'174=:} primitive@> -mp_primitive(mp, "|=:>",lig_kern_token,6); -@:=:/>_}{\.{\char'174=:>} primitive@> -mp_primitive(mp, "|=:|",lig_kern_token,3); -@:=:/_}{\.{\char'174=:\char'174} primitive@> -mp_primitive(mp, "|=:|>",lig_kern_token,7); -@:=:/>_}{\.{\char'174=:\char'174>} primitive@> -mp_primitive(mp, "|=:|>>",lig_kern_token,11); -@:=:/>_}{\.{\char'174=:\char'174>>} primitive@> -mp_primitive(mp, "kern",lig_kern_token,128); -@:kern_}{\&{kern} primitive@> - -@ @<Cases of |print_cmd...@>= -case lig_kern_token: - switch (m) { - case 0:mp_print(mp, "=:"); break; - case 1:mp_print(mp, "=:|"); break; - case 2:mp_print(mp, "|=:"); break; - case 3:mp_print(mp, "|=:|"); break; - case 5:mp_print(mp, "=:|>"); break; - case 6:mp_print(mp, "|=:>"); break; - case 7:mp_print(mp, "|=:|>"); break; - case 11:mp_print(mp, "|=:|>>"); break; - default: mp_print(mp, "kern"); break; - } - break; - -@ Local labels are implemented by maintaining the |skip_table| array, -where |skip_table[c]| is either |undefined_label| or the address of the -most recent lig/kern instruction that skips to local label~|c|. In the -latter case, the |skip_byte| in that instruction will (temporarily) -be zero if there were no prior skips to this label, or it will be the -distance to the prior skip. - -We may need to cancel skips that span more than 127 lig/kern steps. - -@d cancel_skips(A) mp->ll=(A); - do { - mp->lll=qo(skip_byte(mp->ll)); - skip_byte(mp->ll)=stop_flag; mp->ll=mp->ll-mp->lll; - } while (mp->lll!=0) -@d skip_error(A) { print_err("Too far to skip"); -@.Too far to skip@> - help1("At most 127 lig/kern steps can separate skipto1 from 1::."); - mp_error(mp); cancel_skips((A)); - } - -@<Process a |skip_to| command and |goto done|@>= -{ - c=mp_get_code(mp); - if ( mp->nl-mp->skip_table[c]>128 ) { - skip_error(mp->skip_table[c]); mp->skip_table[c]=undefined_label; - } - if ( mp->skip_table[c]==undefined_label ) skip_byte(mp->nl-1)=qi(0); - else skip_byte(mp->nl-1)=qi(mp->nl-mp->skip_table[c]-1); - mp->skip_table[c]=mp->nl-1; goto DONE; -} - -@ @<Record a label in a lig/kern subprogram and |goto continue|@>= -{ - if ( mp->cur_cmd==colon ) { - if ( c==256 ) mp->bch_label=mp->nl; - else mp_set_tag(mp, c,lig_tag,mp->nl); - } else if ( mp->skip_table[c]<undefined_label ) { - mp->ll=mp->skip_table[c]; mp->skip_table[c]=undefined_label; - do { - mp->lll=qo(skip_byte(mp->ll)); - if ( mp->nl-mp->ll>128 ) { - skip_error(mp->ll); goto CONTINUE; - } - skip_byte(mp->ll)=qi(mp->nl-mp->ll-1); mp->ll=mp->ll-mp->lll; - } while (mp->lll!=0); - } - goto CONTINUE; -} - -@ @<Compile a ligature/kern...@>= -{ - next_char(mp->nl)=qi(c); skip_byte(mp->nl)=qi(0); - if ( mp->cur_mod<128 ) { /* ligature op */ - op_byte(mp->nl)=qi(mp->cur_mod); rem_byte(mp->nl)=qi(mp_get_code(mp)); - } else { - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type!=mp_known ) { - exp_err("Improper kern"); -@.Improper kern@> - help2("The amount of kern should be a known numeric value.", - "I'm zeroing this one. Proceed, with fingers crossed."); - mp_put_get_flush_error(mp, 0); - } - mp->kern[mp->nk]=mp->cur_exp; - k=0; - while ( mp->kern[k]!=mp->cur_exp ) incr(k); - if ( k==mp->nk ) { - if ( mp->nk==max_tfm_int ) mp_fatal_error(mp, "too many TFM kerns"); - incr(mp->nk); - } - op_byte(mp->nl)=kern_flag+(k / 256); - rem_byte(mp->nl)=qi((k % 256)); - } - mp->lk_started=true; -} - -@ @d missing_extensible_punctuation(A) - { mp_missing_err(mp, (A)); -@.Missing `\char`\#'@> - help1("I'm processing `extensible c: t,m,b,r'."); mp_back_error(mp); - } - -@<Define an extensible recipe@>= -{ - if ( mp->ne==256 ) mp_fatal_error(mp, "too many extensible recipies"); - c=mp_get_code(mp); mp_set_tag(mp, c,ext_tag,mp->ne); - if ( mp->cur_cmd!=colon ) missing_extensible_punctuation(":"); - ext_top(mp->ne)=qi(mp_get_code(mp)); - if ( mp->cur_cmd!=comma ) missing_extensible_punctuation(","); - ext_mid(mp->ne)=qi(mp_get_code(mp)); - if ( mp->cur_cmd!=comma ) missing_extensible_punctuation(","); - ext_bot(mp->ne)=qi(mp_get_code(mp)); - if ( mp->cur_cmd!=comma ) missing_extensible_punctuation(","); - ext_rep(mp->ne)=qi(mp_get_code(mp)); - incr(mp->ne); -} - -@ The header could contain ASCII zeroes, so can't use |strdup|. - -@<Store a list of header bytes@>= -do { - if ( j>=mp->header_size ) { - size_t l = (size_t)(mp->header_size + (mp->header_size/4)); - char *t = xmalloc(l,1); - memset(t,0,l); - memcpy(t,mp->header_byte,(size_t)mp->header_size); - xfree (mp->header_byte); - mp->header_byte = t; - mp->header_size = (int)l; - } - mp->header_byte[j]=(char)mp_get_code(mp); - incr(j); incr(mp->header_last); -} while (mp->cur_cmd==comma) - -@ @<Store a list of font dimensions@>= -do { - if ( j>max_tfm_int ) mp_fatal_error(mp, "too many fontdimens"); - while ( j>mp->np ) { incr(mp->np); mp->param[mp->np]=0; }; - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type!=mp_known ){ - exp_err("Improper font parameter"); -@.Improper font parameter@> - help1("I'm zeroing this one. Proceed, with fingers crossed."); - mp_put_get_flush_error(mp, 0); - } - mp->param[j]=mp->cur_exp; incr(j); -} while (mp->cur_cmd==comma) - -@ OK: We've stored all the data that is needed for the \.{TFM} file. -All that remains is to output it in the correct format. - -An interesting problem needs to be solved in this connection, because -the \.{TFM} format allows at most 256~widths, 16~heights, 16~depths, -and 64~italic corrections. If the data has more distinct values than -this, we want to meet the necessary restrictions by perturbing the -given values as little as possible. - -\MP\ solves this problem in two steps. First the values of a given -kind (widths, heights, depths, or italic corrections) are sorted; -then the list of sorted values is perturbed, if necessary. - -The sorting operation is facilitated by having a special node of -essentially infinite |value| at the end of the current list. - -@<Initialize table entries...@>= -value(inf_val)=fraction_four; - -@ Straight linear insertion is good enough for sorting, since the lists -are usually not terribly long. As we work on the data, the current list -will start at |mp_link(temp_head)| and end at |inf_val|; the nodes in this -list will be in increasing order of their |value| fields. - -Given such a list, the |sort_in| function takes a value and returns a pointer -to where that value can be found in the list. The value is inserted in -the proper place, if necessary. - -At the time we need to do these operations, most of \MP's work has been -completed, so we will have plenty of memory to play with. The value nodes -that are allocated for sorting will never be returned to free storage. - -@d clear_the_list mp_link(temp_head)=inf_val - -@c -static pointer mp_sort_in (MP mp,scaled v) { - pointer p,q,r; /* list manipulation registers */ - p=temp_head; - while (1) { - q=mp_link(p); - if ( v<=value(q) ) break; - p=q; - } - if ( v<value(q) ) { - r=mp_get_node(mp, value_node_size); value(r)=v; mp_link(r)=q; mp_link(p)=r; - } - return mp_link(p); -} - -@ Now we come to the interesting part, where we reduce the list if necessary -until it has the required size. The |min_cover| routine is basic to this -process; it computes the minimum number~|m| such that the values of the -current sorted list can be covered by |m|~intervals of width~|d|. It -also sets the global value |perturbation| to the smallest value $d'>d$ -such that the covering found by this algorithm would be different. - -In particular, |min_cover(0)| returns the number of distinct values in the -current list and sets |perturbation| to the minimum distance between -adjacent values. - -@c -static integer mp_min_cover (MP mp,scaled d) { - pointer p; /* runs through the current list */ - scaled l; /* the least element covered by the current interval */ - integer m; /* lower bound on the size of the minimum cover */ - m=0; p=mp_link(temp_head); mp->perturbation=el_gordo; - while ( p!=inf_val ){ - incr(m); l=value(p); - do { p=mp_link(p); } while (value(p)<=l+d); - if ( value(p)-l<mp->perturbation ) - mp->perturbation=value(p)-l; - } - return m; -} - -@ @<Glob...@>= -scaled perturbation; /* quantity related to \.{TFM} rounding */ -integer excess; /* the list is this much too long */ - -@ The smallest |d| such that a given list can be covered with |m| intervals -is determined by the |threshold| routine, which is sort of an inverse -to |min_cover|. The idea is to increase the interval size rapidly until -finding the range, then to go sequentially until the exact borderline has -been discovered. - -@c -static scaled mp_threshold (MP mp,integer m) { - scaled d; /* lower bound on the smallest interval size */ - mp->excess=mp_min_cover(mp, 0)-m; - if ( mp->excess<=0 ) { - return 0; - } else { - do { - d=mp->perturbation; - } while (mp_min_cover(mp, d+d)>m); - while ( mp_min_cover(mp, d)>m ) - d=mp->perturbation; - return d; - } -} - -@ The |skimp| procedure reduces the current list to at most |m| entries, -by changing values if necessary. It also sets |mp_info(p):=k| if |value(p)| -is the |k|th distinct value on the resulting list, and it sets -|perturbation| to the maximum amount by which a |value| field has -been changed. The size of the resulting list is returned as the -value of |skimp|. - -@c -static integer mp_skimp (MP mp,integer m) { - scaled d; /* the size of intervals being coalesced */ - pointer p,q,r; /* list manipulation registers */ - scaled l; /* the least value in the current interval */ - scaled v; /* a compromise value */ - d=mp_threshold(mp, m); mp->perturbation=0; - q=temp_head; m=0; p=mp_link(temp_head); - while ( p!=inf_val ) { - incr(m); l=value(p); mp_info(p)=m; - if ( value(mp_link(p))<=l+d ) { - @<Replace an interval of values by its midpoint@>; - } - q=p; p=mp_link(p); - } - return m; -} - -@ @<Replace an interval...@>= -{ - do { - p=mp_link(p); mp_info(p)=m; - decr(mp->excess); if ( mp->excess==0 ) d=0; - } while (value(mp_link(p))<=l+d); - v=l+halfp(value(p)-l); - if ( value(p)-v>mp->perturbation ) - mp->perturbation=value(p)-v; - r=q; - do { - r=mp_link(r); value(r)=v; - } while (r!=p); - mp_link(q)=p; /* remove duplicate values from the current list */ -} - -@ A warning message is issued whenever something is perturbed by -more than 1/16\thinspace pt. - -@c -static void mp_tfm_warning (MP mp,quarterword m) { - mp_print_nl(mp, "(some "); - mp_print(mp, mp->int_name[m]); -@.some charwds...@> -@.some chardps...@> -@.some charhts...@> -@.some charics...@> - mp_print(mp, " values had to be adjusted by as much as "); - mp_print_scaled(mp, mp->perturbation); mp_print(mp, "pt)"); -} - -@ Here's an example of how we use these routines. -The width data needs to be perturbed only if there are 256 distinct -widths, but \MP\ must check for this case even though it is -highly unusual. - -An integer variable |k| will be defined when we use this code. -The |dimen_head| array will contain pointers to the sorted -lists of dimensions. - -@<Massage the \.{TFM} widths@>= -clear_the_list; -for (k=mp->bc;k<=mp->ec;k++) { - if ( mp->char_exists[k] ) - mp->tfm_width[k]=mp_sort_in(mp, mp->tfm_width[k]); -} -mp->nw=mp_skimp(mp, 255)+1; mp->dimen_head[1]=mp_link(temp_head); -if ( mp->perturbation>=010000 ) mp_tfm_warning(mp, mp_char_wd) - -@ @<Glob...@>= -pointer dimen_head[5]; /* lists of \.{TFM} dimensions */ - -@ Heights, depths, and italic corrections are different from widths -not only because their list length is more severely restricted, but -also because zero values do not need to be put into the lists. - -@<Massage the \.{TFM} heights, depths, and italic corrections@>= -clear_the_list; -for (k=mp->bc;k<=mp->ec;k++) { - if ( mp->char_exists[k] ) { - if ( mp->tfm_height[k]==0 ) mp->tfm_height[k]=zero_val; - else mp->tfm_height[k]=mp_sort_in(mp, mp->tfm_height[k]); - } -} -mp->nh=mp_skimp(mp, 15)+1; mp->dimen_head[2]=mp_link(temp_head); -if ( mp->perturbation>=010000 ) mp_tfm_warning(mp, mp_char_ht); -clear_the_list; -for (k=mp->bc;k<=mp->ec;k++) { - if ( mp->char_exists[k] ) { - if ( mp->tfm_depth[k]==0 ) mp->tfm_depth[k]=zero_val; - else mp->tfm_depth[k]=mp_sort_in(mp, mp->tfm_depth[k]); - } -} -mp->nd=mp_skimp(mp, 15)+1; mp->dimen_head[3]=mp_link(temp_head); -if ( mp->perturbation>=010000 ) mp_tfm_warning(mp, mp_char_dp); -clear_the_list; -for (k=mp->bc;k<=mp->ec;k++) { - if ( mp->char_exists[k] ) { - if ( mp->tfm_ital_corr[k]==0 ) mp->tfm_ital_corr[k]=zero_val; - else mp->tfm_ital_corr[k]=mp_sort_in(mp, mp->tfm_ital_corr[k]); - } -} -mp->ni=mp_skimp(mp, 63)+1; mp->dimen_head[4]=mp_link(temp_head); -if ( mp->perturbation>=010000 ) mp_tfm_warning(mp, mp_char_ic) - -@ @<Initialize table entries...@>= -value(zero_val)=0; mp_info(zero_val)=0; - -@ Bytes 5--8 of the header are set to the design size, unless the user has -some crazy reason for specifying them differently. -@^design size@> - -Error messages are not allowed at the time this procedure is called, -so a warning is printed instead. - -The value of |max_tfm_dimen| is calculated so that -$$\hbox{|make_scaled(16*max_tfm_dimen,internal[mp_design_size])|} - < \\{three\_bytes}.$$ - -@d three_bytes 0100000000 /* $2^{24}$ */ - -@c -static void mp_fix_design_size (MP mp) { - scaled d; /* the design size */ - d=mp->internal[mp_design_size]; - if ( (d<unity)||(d>=fraction_half) ) { - if ( d!=0 ) - mp_print_nl(mp, "(illegal design size has been changed to 128pt)"); -@.illegal design size...@> - d=040000000; mp->internal[mp_design_size]=d; - } - if ( mp->header_byte[4]==0 && mp->header_byte[5]==0 && - mp->header_byte[6]==0 && mp->header_byte[7]==0 ) { - mp->header_byte[4]=d / 04000000; - mp->header_byte[5]=(d / 4096) % 256; - mp->header_byte[6]=(d / 16) % 256; - mp->header_byte[7]=(d % 16)*16; - } - mp->max_tfm_dimen=16*mp->internal[mp_design_size]-1-mp->internal[mp_design_size] / 010000000; - if ( mp->max_tfm_dimen>=fraction_half ) mp->max_tfm_dimen=fraction_half-1; -} - -@ The |dimen_out| procedure computes a |fix_word| relative to the -design size. If the data was out of range, it is corrected and the -global variable |tfm_changed| is increased by~one. - -@c -static integer mp_dimen_out (MP mp,scaled x) { - if ( abs(x)>mp->max_tfm_dimen ) { - incr(mp->tfm_changed); - if ( x>0 ) x=mp->max_tfm_dimen; else x=-mp->max_tfm_dimen; - } - x=mp_make_scaled(mp, x*16,mp->internal[mp_design_size]); - return x; -} - -@ @<Glob...@>= -scaled max_tfm_dimen; /* bound on widths, heights, kerns, etc. */ -integer tfm_changed; /* the number of data entries that were out of bounds */ - -@ If the user has not specified any of the first four header bytes, -the |fix_check_sum| procedure replaces them by a ``check sum'' computed -from the |tfm_width| data relative to the design size. -@^check sum@> - -@c -static void mp_fix_check_sum (MP mp) { - eight_bits k; /* runs through character codes */ - eight_bits B1,B2,B3,B4; /* bytes of the check sum */ - integer x; /* hash value used in check sum computation */ - if ( mp->header_byte[0]==0 && mp->header_byte[1]==0 && - mp->header_byte[2]==0 && mp->header_byte[3]==0 ) { - @<Compute a check sum in |(b1,b2,b3,b4)|@>; - mp->header_byte[0]=(char)B1; mp->header_byte[1]=(char)B2; - mp->header_byte[2]=(char)B3; mp->header_byte[3]=(char)B4; - return; - } -} - -@ @<Compute a check sum in |(b1,b2,b3,b4)|@>= -B1=mp->bc; B2=mp->ec; B3=mp->bc; B4=mp->ec; mp->tfm_changed=0; -for (k=mp->bc;k<=mp->ec;k++) { - if ( mp->char_exists[k] ) { - x=mp_dimen_out(mp, value(mp->tfm_width[k]))+(k+4)*020000000; /* this is positive */ - B1=(eight_bits)((B1+B1+x) % 255); - B2=(eight_bits)((B2+B2+x) % 253); - B3=(eight_bits)((B3+B3+x) % 251); - B4=(eight_bits)((B4+B4+x) % 247); - } - if (k==mp->ec) break; -} - -@ Finally we're ready to actually write the \.{TFM} information. -Here are some utility routines for this purpose. - -@d tfm_out(A) do { /* output one byte to |tfm_file| */ - unsigned char s=(unsigned char)(A); - (mp->write_binary_file)(mp,mp->tfm_file,(void *)&s,1); - } while (0) - -@c -static void mp_tfm_two (MP mp,integer x) { /* output two bytes to |tfm_file| */ - tfm_out(x / 256); tfm_out(x % 256); -} -static void mp_tfm_four (MP mp,integer x) { /* output four bytes to |tfm_file| */ - if ( x>=0 ) tfm_out(x / three_bytes); - else { - x=x+010000000000; /* use two's complement for negative values */ - x=x+010000000000; - tfm_out((x / three_bytes) + 128); - }; - x=x % three_bytes; tfm_out(x / unity); - x=x % unity; tfm_out(x / 0400); - tfm_out(x % 0400); -} -static void mp_tfm_qqqq (MP mp,four_quarters x) { /* output four quarterwords to |tfm_file| */ - tfm_out(qo(x.b0)); tfm_out(qo(x.b1)); - tfm_out(qo(x.b2)); tfm_out(qo(x.b3)); -} - -@ @<Finish the \.{TFM} file@>= -if ( mp->job_name==NULL ) mp_open_log_file(mp); -mp_pack_job_name(mp, ".tfm"); -while ( ! mp_b_open_out(mp, &mp->tfm_file, mp_filetype_metrics) ) - mp_prompt_file_name(mp, "file name for font metrics",".tfm"); -mp->metric_file_name=xstrdup(mp->name_of_file); -@<Output the subfile sizes and header bytes@>; -@<Output the character information bytes, then - output the dimensions themselves@>; -@<Output the ligature/kern program@>; -@<Output the extensible character recipes and the font metric parameters@>; - if ( mp->internal[mp_tracing_stats]>0 ) - @<Log the subfile sizes of the \.{TFM} file@>; -mp_print_nl(mp, "Font metrics written on "); -mp_print(mp, mp->metric_file_name); mp_print_char(mp, xord('.')); -@.Font metrics written...@> -(mp->close_file)(mp,mp->tfm_file) - -@ Integer variables |lh|, |k|, and |lk_offset| will be defined when we use -this code. - -@<Output the subfile sizes and header bytes@>= -k=mp->header_last; -LH=(k+4) / 4; /* this is the number of header words */ -if ( mp->bc>mp->ec ) mp->bc=1; /* if there are no characters, |ec=0| and |bc=1| */ -@<Compute the ligature/kern program offset and implant the - left boundary label@>; -mp_tfm_two(mp,6+LH+(mp->ec-mp->bc+1)+mp->nw+mp->nh+mp->nd+mp->ni+mp->nl - +lk_offset+mp->nk+mp->ne+mp->np); - /* this is the total number of file words that will be output */ -mp_tfm_two(mp, LH); mp_tfm_two(mp, mp->bc); mp_tfm_two(mp, mp->ec); -mp_tfm_two(mp, mp->nw); mp_tfm_two(mp, mp->nh); -mp_tfm_two(mp, mp->nd); mp_tfm_two(mp, mp->ni); mp_tfm_two(mp, mp->nl+lk_offset); -mp_tfm_two(mp, mp->nk); mp_tfm_two(mp, mp->ne); -mp_tfm_two(mp, mp->np); -for (k=0;k< 4*LH;k++) { - tfm_out(mp->header_byte[k]); -} - -@ @<Output the character information bytes...@>= -for (k=mp->bc;k<=mp->ec;k++) { - if ( ! mp->char_exists[k] ) { - mp_tfm_four(mp, 0); - } else { - tfm_out(mp_info(mp->tfm_width[k])); /* the width index */ - tfm_out((mp_info(mp->tfm_height[k]))*16+mp_info(mp->tfm_depth[k])); - tfm_out((mp_info(mp->tfm_ital_corr[k]))*4+mp->char_tag[k]); - tfm_out(mp->char_remainder[k]); - }; -} -mp->tfm_changed=0; -for (k=1;k<=4;k++) { - mp_tfm_four(mp, 0); p=mp->dimen_head[k]; - while ( p!=inf_val ) { - mp_tfm_four(mp, mp_dimen_out(mp, value(p))); p=mp_link(p); - } -} - - -@ We need to output special instructions at the beginning of the -|lig_kern| array in order to specify the right boundary character -and/or to handle starting addresses that exceed 255. The |label_loc| -and |label_char| arrays have been set up to record all the -starting addresses; we have $-1=|label_loc|[0]<|label_loc|[1]\le\cdots -\le|label_loc|[|label_ptr]|$. - -@<Compute the ligature/kern program offset...@>= -mp->bchar=mp_round_unscaled(mp, mp->internal[mp_boundary_char]); -if ((mp->bchar<0)||(mp->bchar>255)) { - mp->bchar=-1; mp->lk_started=false; lk_offset=0; -} else { - mp->lk_started=true; lk_offset=1; -} -@<Find the minimum |lk_offset| and adjust all remainders@>; -if ( mp->bch_label<undefined_label ) - { skip_byte(mp->nl)=qi(255); next_char(mp->nl)=qi(0); - op_byte(mp->nl)=qi(((mp->bch_label+lk_offset)/ 256)); - rem_byte(mp->nl)=qi(((mp->bch_label+lk_offset)% 256)); - incr(mp->nl); /* possibly |nl=lig_table_size+1| */ - } - -@ @<Find the minimum |lk_offset|...@>= -k=mp->label_ptr; /* pointer to the largest unallocated label */ -if ( mp->label_loc[k]+lk_offset>255 ) { - lk_offset=0; mp->lk_started=false; /* location 0 can do double duty */ - do { - mp->char_remainder[mp->label_char[k]]=lk_offset; - while ( mp->label_loc[k-1]==mp->label_loc[k] ) { - decr(k); mp->char_remainder[mp->label_char[k]]=lk_offset; - } - incr(lk_offset); decr(k); - } while (! (lk_offset+mp->label_loc[k]<256)); - /* N.B.: |lk_offset=256| satisfies this when |k=0| */ -} -if ( lk_offset>0 ) { - while ( k>0 ) { - mp->char_remainder[mp->label_char[k]] - =mp->char_remainder[mp->label_char[k]]+lk_offset; - decr(k); - } -} - -@ @<Output the ligature/kern program@>= -for (k=0;k<= 255;k++ ) { - if ( mp->skip_table[k]<undefined_label ) { - mp_print_nl(mp, "(local label "); mp_print_int(mp, k); mp_print(mp, ":: was missing)"); -@.local label l:: was missing@> - cancel_skips(mp->skip_table[k]); - } -} -if ( mp->lk_started ) { /* |lk_offset=1| for the special |bchar| */ - tfm_out(255); tfm_out(mp->bchar); mp_tfm_two(mp, 0); -} else { - for (k=1;k<=lk_offset;k++) {/* output the redirection specs */ - mp->ll=mp->label_loc[mp->label_ptr]; - if ( mp->bchar<0 ) { tfm_out(254); tfm_out(0); } - else { tfm_out(255); tfm_out(mp->bchar); }; - mp_tfm_two(mp, mp->ll+lk_offset); - do { - decr(mp->label_ptr); - } while (! (mp->label_loc[mp->label_ptr]<mp->ll)); - } -} -for (k=0;k<mp->nl;k++) mp_tfm_qqqq(mp, mp->lig_kern[k]); -for (k=0;k<mp->nk;k++) mp_tfm_four(mp, mp_dimen_out(mp, mp->kern[k])) - -@ @<Output the extensible character recipes...@>= -for (k=0;k<mp->ne;k++) - mp_tfm_qqqq(mp, mp->exten[k]); -for (k=1;k<=mp->np;k++) { - if ( k==1 ) { - if ( abs(mp->param[1])<fraction_half ) { - mp_tfm_four(mp, mp->param[1]*16); - } else { - incr(mp->tfm_changed); - if ( mp->param[1]>0 ) mp_tfm_four(mp, el_gordo); - else mp_tfm_four(mp, -el_gordo); - } - } else { - mp_tfm_four(mp, mp_dimen_out(mp, mp->param[k])); - } -} -if ( mp->tfm_changed>0 ) { - if ( mp->tfm_changed==1 ) mp_print_nl(mp, "(a font metric dimension"); -@.a font metric dimension...@> - else { - mp_print_nl(mp, "("); mp_print_int(mp, mp->tfm_changed); -@.font metric dimensions...@> - mp_print(mp, " font metric dimensions"); - } - mp_print(mp, " had to be decreased)"); -} - -@ @<Log the subfile sizes of the \.{TFM} file@>= -{ - char s[200]; - wlog_ln(" "); - if ( mp->bch_label<undefined_label ) decr(mp->nl); - mp_snprintf(s,128,"(You used %iw,%ih,%id,%ii,%il,%ik,%ie,%ip metric file positions)", - mp->nw, mp->nh, mp->nd, mp->ni, mp->nl, mp->nk, mp->ne,mp->np); - wlog_ln(s); -} - -@* \[43] Reading font metric data. - -\MP\ isn't a typesetting program but it does need to find the bounding box -of a sequence of typeset characters. Thus it needs to read \.{TFM} files as -well as write them. - -@<Glob...@>= -void * tfm_infile; - -@ All the width, height, and depth information is stored in an array called -|font_info|. This array is allocated sequentially and each font is stored -as a series of |char_info| words followed by the width, height, and depth -tables. Since |font_name| entries are permanent, their |str_ref| values are -set to |max_str_ref|. - -@<Types...@>= -typedef unsigned int font_number; /* |0..font_max| */ - -@ The |font_info| array is indexed via a group directory arrays. -For example, the |char_info| data for character~|c| in font~|f| will be -in |font_info[char_base[f]+c].qqqq|. - -@<Glob...@>= -font_number font_max; /* maximum font number for included text fonts */ -size_t font_mem_size; /* number of words for \.{TFM} information for text fonts */ -memory_word *font_info; /* height, width, and depth data */ -char **font_enc_name; /* encoding names, if any */ -boolean *font_ps_name_fixed; /* are the postscript names fixed already? */ -size_t next_fmem; /* next unused entry in |font_info| */ -font_number last_fnum; /* last font number used so far */ -scaled *font_dsize; /* 16 times the ``design'' size in \ps\ points */ -char **font_name; /* name as specified in the \&{infont} command */ -char **font_ps_name; /* PostScript name for use when |internal[mp_prologues]>0| */ -font_number last_ps_fnum; /* last valid |font_ps_name| index */ -eight_bits *font_bc; -eight_bits *font_ec; /* first and last character code */ -int *char_base; /* base address for |char_info| */ -int *width_base; /* index for zeroth character width */ -int *height_base; /* index for zeroth character height */ -int *depth_base; /* index for zeroth character depth */ -pointer *font_sizes; - -@ @<Allocate or initialize ...@>= -mp->font_mem_size = 10000; -mp->font_info = xmalloc ((mp->font_mem_size+1),sizeof(memory_word)); -memset (mp->font_info,0,sizeof(memory_word)*(mp->font_mem_size+1)); -mp->last_fnum = null_font; - -@ @<Dealloc variables@>= -for (k=1;k<=(int)mp->last_fnum;k++) { - xfree(mp->font_enc_name[k]); - xfree(mp->font_name[k]); - xfree(mp->font_ps_name[k]); -} -xfree(mp->font_info); -xfree(mp->font_enc_name); -xfree(mp->font_ps_name_fixed); -xfree(mp->font_dsize); -xfree(mp->font_name); -xfree(mp->font_ps_name); -xfree(mp->font_bc); -xfree(mp->font_ec); -xfree(mp->char_base); -xfree(mp->width_base); -xfree(mp->height_base); -xfree(mp->depth_base); -xfree(mp->font_sizes); - -@ -@c -void mp_reallocate_fonts (MP mp, font_number l) { - font_number f; - XREALLOC(mp->font_enc_name, l, char *); - XREALLOC(mp->font_ps_name_fixed, l, boolean); - XREALLOC(mp->font_dsize, l, scaled); - XREALLOC(mp->font_name, l, char *); - XREALLOC(mp->font_ps_name, l, char *); - XREALLOC(mp->font_bc, l, eight_bits); - XREALLOC(mp->font_ec, l, eight_bits); - XREALLOC(mp->char_base, l, int); - XREALLOC(mp->width_base, l, int); - XREALLOC(mp->height_base, l, int); - XREALLOC(mp->depth_base, l, int); - XREALLOC(mp->font_sizes, l, pointer); - for (f=(mp->last_fnum+1);f<=l;f++) { - mp->font_enc_name[f]=NULL; - mp->font_ps_name_fixed[f] = false; - mp->font_name[f]=NULL; - mp->font_ps_name[f]=NULL; - mp->font_sizes[f]=null; - } - mp->font_max = l; -} - -@ @<Internal library declarations@>= -void mp_reallocate_fonts (MP mp, font_number l); - - -@ A |null_font| containing no characters is useful for error recovery. Its -|font_name| entry starts out empty but is reset each time an erroneous font is -found. This helps to cut down on the number of duplicate error messages without -wasting a lot of space. - -@d null_font 0 /* the |font_number| for an empty font */ - -@<Set initial...@>= -mp->font_dsize[null_font]=0; -mp->font_bc[null_font]=1; -mp->font_ec[null_font]=0; -mp->char_base[null_font]=0; -mp->width_base[null_font]=0; -mp->height_base[null_font]=0; -mp->depth_base[null_font]=0; -mp->next_fmem=0; -mp->last_fnum=null_font; -mp->last_ps_fnum=null_font; -mp->font_name[null_font]=(char *)"nullfont"; -mp->font_ps_name[null_font]=(char *)""; -mp->font_ps_name_fixed[null_font] = false; -mp->font_enc_name[null_font]=NULL; -mp->font_sizes[null_font]=null; - -@ Each |char_info| word is of type |four_quarters|. The |b0| field contains -the |width index|; the |b1| field contains the height -index; the |b2| fields contains the depth index, and the |b3| field used only -for temporary storage. (It is used to keep track of which characters occur in -an edge structure that is being shipped out.) -The corresponding words in the width, height, and depth tables are stored as -|scaled| values in units of \ps\ points. - -With the macros below, the |char_info| word for character~|c| in font~|f| is -|char_mp_info(f,c)| and the width is -$$\hbox{|char_width(f,char_mp_info(f,c)).sc|.}$$ - -@d char_mp_info(A,B) mp->font_info[mp->char_base[(A)]+(B)].qqqq -@d char_width(A,B) mp->font_info[mp->width_base[(A)]+(B).b0].sc -@d char_height(A,B) mp->font_info[mp->height_base[(A)]+(B).b1].sc -@d char_depth(A,B) mp->font_info[mp->depth_base[(A)]+(B).b2].sc -@d ichar_exists(A) ((A).b0>0) - -@ When we have a font name and we don't know whether it has been loaded yet, -we scan the |font_name| array before calling |read_font_info|. - -@<Declarations@>= -static font_number mp_find_font (MP mp, char *f) ; - -@ @c -font_number mp_find_font (MP mp, char *f) { - font_number n; - for (n=0;n<=mp->last_fnum;n++) { - if (mp_xstrcmp(f,mp->font_name[n])==0 ) { - mp_xfree(f); - return n; - } - } - n = mp_read_font_info(mp, f); - mp_xfree(f); - return n; -} - -@ This is an interface function for getting the width of character, -as a double in ps units - -@c double mp_get_char_dimension (MP mp, char *fname, int c, int t) { - unsigned n; - four_quarters cc; - font_number f = 0; - double w = -1.0; - for (n=0;n<=mp->last_fnum;n++) { - if (mp_xstrcmp(fname,mp->font_name[n])==0 ) { - f = n; - break; - } - } - if (f==0) - return 0.0; - cc = char_mp_info(f,c); - if (! ichar_exists(cc) ) - return 0.0; - if (t=='w') - w = (double)char_width(f,cc); - else if (t=='h') - w = (double)char_height(f,cc); - else if (t=='d') - w = (double)char_depth(f,cc); - return w/655.35*(72.27/72); -} - -@ @<Exported function ...@>= -double mp_get_char_dimension (MP mp, char *fname, int n, int t); - - -@ One simple application of |find_font| is the implementation of the |font_size| -operator that gets the design size for a given font name. - -@<Find the design size of the font whose name is |cur_exp|@>= -mp_flush_cur_exp(mp, (mp->font_dsize[mp_find_font(mp, str(mp->cur_exp))]+8) / 16) - -@ If we discover that the font doesn't have a requested character, we omit it -from the bounding box computation and expect the \ps\ interpreter to drop it. -This routine issues a warning message if the user has asked for it. - -@<Declarations@>= -static void mp_lost_warning (MP mp,font_number f, pool_pointer k); - -@ @c -void mp_lost_warning (MP mp,font_number f, pool_pointer k) { - if ( mp->internal[mp_tracing_lost_chars]>0 ) { - mp_begin_diagnostic(mp); - if ( mp->selector==log_only ) incr(mp->selector); - mp_print_nl(mp, "Missing character: There is no "); -@.Missing character@> - mp_print_str(mp, mp->str_pool[k]); - mp_print(mp, " in font "); - mp_print(mp, mp->font_name[f]); mp_print_char(mp, xord('!')); - mp_end_diagnostic(mp, false); - } -} - -@ The whole purpose of saving the height, width, and depth information is to be -able to find the bounding box of an item of text in an edge structure. The -|set_text_box| procedure takes a text node and adds this information. - -@<Declarations@>= -static void mp_set_text_box (MP mp,pointer p); - -@ @c -void mp_set_text_box (MP mp,pointer p) { - font_number f; /* |mp_font_n(p)| */ - ASCII_code bc,ec; /* range of valid characters for font |f| */ - pool_pointer k,kk; /* current character and character to stop at */ - four_quarters cc; /* the |char_info| for the current character */ - scaled h,d; /* dimensions of the current character */ - width_val(p)=0; - height_val(p)=-el_gordo; - depth_val(p)=-el_gordo; - f=(font_number)mp_font_n(p); - bc=mp->font_bc[f]; - ec=mp->font_ec[f]; - kk=str_stop(mp_text_p(p)); - k=mp->str_start[mp_text_p(p)]; - while ( k<kk ) { - @<Adjust |p|'s bounding box to contain |str_pool[k]|; advance |k|@>; - } - @<Set the height and depth to zero if the bounding box is empty@>; -} - -@ @<Adjust |p|'s bounding box to contain |str_pool[k]|; advance |k|@>= -{ - if ( (mp->str_pool[k]<bc)||(mp->str_pool[k]>ec) ) { - mp_lost_warning(mp, f,k); - } else { - cc=char_mp_info(f,mp->str_pool[k]); - if ( ! ichar_exists(cc) ) { - mp_lost_warning(mp, f,k); - } else { - width_val(p)=width_val(p)+char_width(f,cc); - h=char_height(f,cc); - d=char_depth(f,cc); - if ( h>height_val(p) ) height_val(p)=h; - if ( d>depth_val(p) ) depth_val(p)=d; - } - } - incr(k); -} - -@ Let's hope modern compilers do comparisons correctly when the difference would -overflow. - -@<Set the height and depth to zero if the bounding box is empty@>= -if ( height_val(p)<-depth_val(p) ) { - height_val(p)=0; - depth_val(p)=0; -} - -@ The new primitives fontmapfile and fontmapline. - -@<Declare action procedures for use by |do_statement|@>= -static void mp_do_mapfile (MP mp) ; -static void mp_do_mapline (MP mp) ; - -@ @c -static void mp_do_mapfile (MP mp) { - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type!=mp_string_type ) { - @<Complain about improper map operation@>; - } else { - mp_map_file(mp,mp->cur_exp); - } -} -static void mp_do_mapline (MP mp) { - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type!=mp_string_type ) { - @<Complain about improper map operation@>; - } else { - mp_map_line(mp,mp->cur_exp); - } -} - -@ @<Complain about improper map operation@>= -{ - exp_err("Unsuitable expression"); - help1("Only known strings can be map files or map lines."); - mp_put_get_error(mp); -} - -@ To print |scaled| value to PDF output we need some subroutines to ensure -accurary. - -@d max_integer 0x7FFFFFFF /* $2^{31}-1$ */ - -@<Glob...@>= -scaled one_bp; /* scaled value corresponds to 1bp */ -scaled one_hundred_bp; /* scaled value corresponds to 100bp */ -scaled one_hundred_inch; /* scaled value corresponds to 100in */ -integer ten_pow[10]; /* $10^0..10^9$ */ -integer scaled_out; /* amount of |scaled| that was taken out in |divide_scaled| */ - -@ @<Set init...@>= -mp->one_bp = 65782; /* 65781.76 */ -mp->one_hundred_bp = 6578176; -mp->one_hundred_inch = 473628672; -mp->ten_pow[0] = 1; -for (i = 1;i<= 9; i++ ) { - mp->ten_pow[i] = 10*mp->ten_pow[i - 1]; -} - -@ The following function divides |s| by |m|. |dd| is number of decimal digits. - -@c scaled mp_divide_scaled (MP mp,scaled s, scaled m, integer dd) { - scaled q,r; - integer sign,i; - sign = 1; - if ( s < 0 ) { sign = -sign; s = -s; } - if ( m < 0 ) { sign = -sign; m = -m; } - if ( m == 0 ) - mp_confusion(mp, "arithmetic: divided by zero"); - else if ( m >= (max_integer / 10) ) - mp_confusion(mp, "arithmetic: number too big"); - q = s / m; - r = s % m; - for (i = 1;i<=dd;i++) { - q = 10*q + (10*r) / m; - r = (10*r) % m; - } - if ( 2*r >= m ) { incr(q); r = r - m; } - mp->scaled_out = sign*(s - (r / mp->ten_pow[dd])); - return (sign*q); -} - -@* \[44] Shipping pictures out. -The |ship_out| procedure, to be described below, is given a pointer to -an edge structure. Its mission is to output a file containing the \ps\ -description of an edge structure. - -@ Each time an edge structure is shipped out we write a new \ps\ output -file named according to the current \&{charcode}. -@:char_code_}{\&{charcode} primitive@> - -This is the only backend function that remains in the main |mpost.w| file. -There are just too many variable accesses needed for status reporting -etcetera to make it worthwile to move the code to |psout.w|. - -@<Internal library declarations@>= -void mp_open_output_file (MP mp) ; - -@ @c -static char *mp_set_output_file_name (MP mp, integer c) { - char *ss = NULL; /* filename extension proposal */ - char *nn = NULL; /* temp string for str() */ - unsigned old_setting; /* previous |selector| setting */ - pool_pointer i; /* indexes into |filename_template| */ - integer cc; /* a temporary integer for template building */ - integer f,g=0; /* field widths */ - if ( mp->job_name==NULL ) mp_open_log_file(mp); - if ( mp->filename_template==0 ) { - char *s; /* a file extension derived from |c| */ - if ( c<0 ) - s=xstrdup(".ps"); - else - @<Use |c| to compute the file extension |s|@>; - mp_pack_job_name(mp, s); - free(s); - ss = xstrdup(mp->name_of_file); - } else { /* initializations */ - str_number s, n; /* a file extension derived from |c| */ - old_setting=mp->selector; - mp->selector=new_string; - f = 0; - i = mp->str_start[mp->filename_template]; - n = null_str; /* initialize */ - while ( i<str_stop(mp->filename_template) ) { - if ( mp->str_pool[i]=='%' ) { - CONTINUE: - incr(i); - if ( i<str_stop(mp->filename_template) ) { - if ( mp->str_pool[i]=='j' ) { - mp_print(mp, mp->job_name); - } else if ( mp->str_pool[i]=='d' ) { - cc= mp_round_unscaled(mp, mp->internal[mp_day]); - print_with_leading_zeroes(cc); - } else if ( mp->str_pool[i]=='m' ) { - cc= mp_round_unscaled(mp, mp->internal[mp_month]); - print_with_leading_zeroes(cc); - } else if ( mp->str_pool[i]=='y' ) { - cc= mp_round_unscaled(mp, mp->internal[mp_year]); - print_with_leading_zeroes(cc); - } else if ( mp->str_pool[i]=='H' ) { - cc= mp_round_unscaled(mp, mp->internal[mp_time]) / 60; - print_with_leading_zeroes(cc); - } else if ( mp->str_pool[i]=='M' ) { - cc= mp_round_unscaled(mp, mp->internal[mp_time]) % 60; - print_with_leading_zeroes(cc); - } else if ( mp->str_pool[i]=='c' ) { - if ( c<0 ) mp_print(mp, "ps"); - else print_with_leading_zeroes(c); - } else if ( (mp->str_pool[i]>='0') && - (mp->str_pool[i]<='9') ) { - if ( (f<10) ) - f = (f*10) + mp->str_pool[i]-'0'; - goto CONTINUE; - } else { - mp_print_str(mp, mp->str_pool[i]); - } - } - } else { - if ( mp->str_pool[i]=='.' ) - if (length(n)==0) - n = mp_make_string(mp); - mp_print_str(mp, mp->str_pool[i]); - }; - incr(i); - } - s = mp_make_string(mp); - mp->selector= old_setting; - if (length(n)==0) { - n=s; - s=null_str; - } - ss = str(s); - nn = str(n); - mp_pack_file_name(mp, nn,"",ss); - free(nn); - delete_str_ref(n); - delete_str_ref(s); - } - return ss; -} - -static char * mp_get_output_file_name (MP mp) { - char *f; - char *saved_name; /* saved |name_of_file| */ - saved_name = xstrdup(mp->name_of_file); - f = xstrdup(mp_set_output_file_name(mp, mp_round_unscaled(mp, mp->internal[mp_char_code]))); - mp_pack_file_name(mp, saved_name,NULL,NULL); - free(saved_name); - return f; -} - -void mp_open_output_file (MP mp) { - char *ss; /* filename extension proposal */ - integer c; /* \&{charcode} rounded to the nearest integer */ - c=mp_round_unscaled(mp, mp->internal[mp_char_code]); - ss = mp_set_output_file_name(mp, c); - while ( ! mp_a_open_out(mp, (void *)&mp->ps_file, mp_filetype_postscript) ) - mp_prompt_file_name(mp, "file name for output",ss); - xfree(ss); - @<Store the true output file name if appropriate@>; -} - -@ The file extension created here could be up to five characters long in -extreme cases so it may have to be shortened on some systems. -@^system dependencies@> - -@<Use |c| to compute the file extension |s|@>= -{ - s = xmalloc(7,1); - mp_snprintf(s,7,".%i",(int)c); -} - -@ The user won't want to see all the output file names so we only save the -first and last ones and a count of how many there were. For this purpose -files are ordered primarily by \&{charcode} and secondarily by order of -creation. -@:char_code_}{\&{charcode} primitive@> - -@<Store the true output file name if appropriate@>= -if ((c<mp->first_output_code)&&(mp->first_output_code>=0)) { - mp->first_output_code=c; - xfree(mp->first_file_name); - mp->first_file_name=xstrdup(mp->name_of_file); -} -if ( c>=mp->last_output_code ) { - mp->last_output_code=c; - xfree(mp->last_file_name); - mp->last_file_name=xstrdup(mp->name_of_file); -} - -@ @<Glob...@>= -char * first_file_name; -char * last_file_name; /* full file names */ -integer first_output_code;integer last_output_code; /* rounded \&{charcode} values */ -@:char_code_}{\&{charcode} primitive@> -integer total_shipped; /* total number of |ship_out| operations completed */ - -@ @<Set init...@>= -mp->first_file_name=xstrdup(""); -mp->last_file_name=xstrdup(""); -mp->first_output_code=32768; -mp->last_output_code=-32768; -mp->total_shipped=0; - -@ @<Dealloc variables@>= -xfree(mp->first_file_name); -xfree(mp->last_file_name); - -@ @<Begin the progress report for the output of picture~|c|@>= -if ( (int)mp->term_offset>mp->max_print_line-6 ) mp_print_ln(mp); -else if ( (mp->term_offset>0)||(mp->file_offset>0) ) mp_print_char(mp, xord(' ')); -mp_print_char(mp, xord('[')); -if ( c>=0 ) mp_print_int(mp, c) - -@ @<End progress report@>= -mp_print_char(mp, xord(']')); -update_terminal; -incr(mp->total_shipped) - -@ @<Explain what output files were written@>= -if ( mp->total_shipped>0 ) { - mp_print_nl(mp, ""); - mp_print_int(mp, mp->total_shipped); - if (mp->noninteractive) { - mp_print(mp, " figure"); - if ( mp->total_shipped>1 ) mp_print_char(mp, xord('s')); - mp_print(mp, " created."); - } else { - mp_print(mp, " output file"); - if ( mp->total_shipped>1 ) mp_print_char(mp, xord('s')); - mp_print(mp, " written: "); - mp_print(mp, mp->first_file_name); - if ( mp->total_shipped>1 ) { - if ( 31+strlen(mp->first_file_name)+ - strlen(mp->last_file_name)> (unsigned)mp->max_print_line) - mp_print_ln(mp); - mp_print(mp, " .. "); - mp_print(mp, mp->last_file_name); - } - } -} - -@ @<Internal library declarations@>= -boolean mp_has_font_size(MP mp, font_number f ); - -@ @c -boolean mp_has_font_size(MP mp, font_number f ) { - return (mp->font_sizes[f]!=null); -} - -@ The \&{special} command saves up lines of text to be printed during the next -|ship_out| operation. The saved items are stored as a list of capsule tokens. - -@<Glob...@>= -pointer last_pending; /* the last token in a list of pending specials */ - -@ @<Set init...@>= -mp->last_pending=spec_head; - -@ @<Cases of |do_statement|...@>= -case special_command: - if ( mp->cur_mod==0 ) mp_do_special(mp); else - if ( mp->cur_mod==1 ) mp_do_mapfile(mp); else - mp_do_mapline(mp); - break; - -@ @<Declare action procedures for use by |do_statement|@>= -static void mp_do_special (MP mp) ; - -@ @c void mp_do_special (MP mp) { - mp_get_x_next(mp); mp_scan_expression(mp); - if ( mp->cur_type!=mp_string_type ) { - @<Complain about improper special operation@>; - } else { - mp_link(mp->last_pending)=mp_stash_cur_exp(mp); - mp->last_pending=mp_link(mp->last_pending); - mp_link(mp->last_pending)=null; - } -} - -@ @<Complain about improper special operation@>= -{ - exp_err("Unsuitable expression"); - help1("Only known strings are allowed for output as specials."); - mp_put_get_error(mp); -} - -@ On the export side, we need an extra object type for special strings. - -@<Graphical object codes@>= -mp_special_code=8, - -@ @<Export pending specials@>= -p=mp_link(spec_head); -while ( p!=null ) { - mp_special_object *tp; - tp = (mp_special_object *)mp_new_graphic_object(mp,mp_special_code); - gr_pre_script(tp) = str(value(p)); - if (hh->body==NULL) hh->body = (mp_graphic_object *)tp; - else gr_link(hp) = (mp_graphic_object *)tp; - hp = (mp_graphic_object *)tp; - p=mp_link(p); -} -mp_flush_token_list(mp, mp_link(spec_head)); -mp_link(spec_head)=null; -mp->last_pending=spec_head - -@ We are now ready for the main output procedure. Note that the |selector| -setting is saved in a global variable so that |begin_diagnostic| can access it. - -@<Declare the \ps\ output procedures@>= -static void mp_ship_out (MP mp, pointer h) ; - -@ Once again, the |gr_XXXX| macros are defined in |mppsout.h| - -@d export_color(q,p) - if ( mp_color_model(p)==mp_uninitialized_model ) { - gr_color_model(q) = (unsigned char)(mp->internal[mp_default_color_model]/65536); - gr_cyan_val(q) = 0; - gr_magenta_val(q) = 0; - gr_yellow_val(q) = 0; - gr_black_val(q) = (gr_color_model(q)==mp_cmyk_model ? unity : 0); - } else { - gr_color_model(q) = (unsigned char)mp_color_model(p); - gr_cyan_val(q) = cyan_val(p); - gr_magenta_val(q) = magenta_val(p); - gr_yellow_val(q) = yellow_val(p); - gr_black_val(q) = black_val(p); - } - -@d export_scripts(q,p) - if (mp_pre_script(p)!=null) gr_pre_script(q) = str(mp_pre_script(p)); - if (mp_post_script(p)!=null) gr_post_script(q) = str(mp_post_script(p)); - -@c -struct mp_edge_object *mp_gr_export(MP mp, pointer h) { - pointer p; /* the current graphical object */ - integer t; /* a temporary value */ - integer c; /* a rounded charcode */ - scaled d_width; /* the current pen width */ - mp_edge_object *hh; /* the first graphical object */ - mp_graphic_object *hq; /* something |hp| points to */ - mp_text_object *tt; - mp_fill_object *tf; - mp_stroked_object *ts; - mp_clip_object *tc; - mp_bounds_object *tb; - mp_graphic_object *hp = NULL; /* the current graphical object */ - mp_set_bbox(mp, h, true); - hh = xmalloc(1,sizeof(mp_edge_object)); - hh->body = NULL; - hh->next = NULL; - hh->parent = mp; - hh->minx = minx_val(h); - hh->miny = miny_val(h); - hh->maxx = maxx_val(h); - hh->maxy = maxy_val(h); - hh->filename = mp_get_output_file_name(mp); - c = mp_round_unscaled(mp,mp->internal[mp_char_code]); - hh->charcode = c; - hh->width = mp->internal[mp_char_wd]; - hh->height = mp->internal[mp_char_ht]; - hh->depth = mp->internal[mp_char_dp]; - hh->ital_corr = mp->internal[mp_char_ic]; - @<Export pending specials@>; - p=mp_link(dummy_loc(h)); - while ( p!=null ) { - hq = mp_new_graphic_object(mp,mp_type(p)); - switch (mp_type(p)) { - case mp_fill_code: - tf = (mp_fill_object *)hq; - gr_pen_p(tf) = mp_export_knot_list(mp,mp_pen_p(p)); - d_width = mp_get_pen_scale(mp, mp_pen_p(p)); - if ((mp_pen_p(p)==null) || pen_is_elliptical(mp_pen_p(p))) { - gr_path_p(tf) = mp_export_knot_list(mp,mp_path_p(p)); - } else { - pointer pc, pp; - pc = mp_copy_path(mp, mp_path_p(p)); - pp = mp_make_envelope(mp, pc, mp_pen_p(p),ljoin_val(p),0,miterlim_val(p)); - gr_path_p(tf) = mp_export_knot_list(mp,pp); - mp_toss_knot_list(mp, pp); - pc = mp_htap_ypoc(mp, mp_path_p(p)); - pp = mp_make_envelope(mp, pc, mp_pen_p(p),ljoin_val(p),0,miterlim_val(p)); - gr_htap_p(tf) = mp_export_knot_list(mp,pp); - mp_toss_knot_list(mp, pp); - } - export_color(tf,p) ; - export_scripts(tf,p); - gr_ljoin_val(tf) = (unsigned char)ljoin_val(p); - gr_miterlim_val(tf) = miterlim_val(p); - break; - case mp_stroked_code: - ts = (mp_stroked_object *)hq; - gr_pen_p(ts) = mp_export_knot_list(mp,mp_pen_p(p)); - d_width = mp_get_pen_scale(mp, mp_pen_p(p)); - if (pen_is_elliptical(mp_pen_p(p))) { - gr_path_p(ts) = mp_export_knot_list(mp,mp_path_p(p)); - } else { - pointer pc; - pc=mp_copy_path(mp, mp_path_p(p)); - t=lcap_val(p); - if ( mp_left_type(pc)!=mp_endpoint ) { - mp_left_type(mp_insert_knot(mp, pc,mp_x_coord(pc),mp_y_coord(pc)))=mp_endpoint; - mp_right_type(pc)=mp_endpoint; - pc=mp_link(pc); - t=1; - } - pc=mp_make_envelope(mp,pc,mp_pen_p(p),ljoin_val(p),t,miterlim_val(p)); - gr_path_p(ts) = mp_export_knot_list(mp,pc); - mp_toss_knot_list(mp, pc); - } - export_color(ts,p) ; - export_scripts(ts,p); - gr_ljoin_val(ts) = (unsigned char)ljoin_val(p); - gr_miterlim_val(ts) = miterlim_val(p); - gr_lcap_val(ts) = (unsigned char)lcap_val(p); - gr_dash_p(ts) = mp_export_dashes(mp,p,&d_width); - break; - case mp_text_code: - tt = (mp_text_object *)hq; - gr_text_p(tt) = str(mp_text_p(p)); - gr_text_l(tt) = (size_t)length(mp_text_p(p)); - gr_font_n(tt) = (unsigned int)mp_font_n(p); - gr_font_name(tt) = mp_xstrdup(mp,mp->font_name[mp_font_n(p)]); - gr_font_dsize(tt) = (unsigned int)mp->font_dsize[mp_font_n(p)]; - export_color(tt,p) ; - export_scripts(tt,p); - gr_width_val(tt) = width_val(p); - gr_height_val(tt) = height_val(p); - gr_depth_val(tt) = depth_val(p); - gr_tx_val(tt) = tx_val(p); - gr_ty_val(tt) = ty_val(p); - gr_txx_val(tt) = txx_val(p); - gr_txy_val(tt) = txy_val(p); - gr_tyx_val(tt) = tyx_val(p); - gr_tyy_val(tt) = tyy_val(p); - break; - case mp_start_clip_code: - tc = (mp_clip_object *)hq; - gr_path_p(tc) = mp_export_knot_list(mp,mp_path_p(p)); - break; - case mp_start_bounds_code: - tb = (mp_bounds_object *)hq; - gr_path_p(tb) = mp_export_knot_list(mp,mp_path_p(p)); - break; - case mp_stop_clip_code: - case mp_stop_bounds_code: - /* nothing to do here */ - break; - } - if (hh->body==NULL) hh->body=hq; else gr_link(hp) = hq; - hp = hq; - p=mp_link(p); - } - return hh; -} - -@ @<Declarations@>= -static struct mp_edge_object *mp_gr_export(MP mp, int h); - -@ This function is now nearly trivial. - -@c -void mp_ship_out (MP mp, pointer h) { /* output edge structure |h| */ - integer c; /* \&{charcode} rounded to the nearest integer */ - c=mp_round_unscaled(mp, mp->internal[mp_char_code]); - @<Begin the progress report for the output of picture~|c|@>; - (mp->shipout_backend) (mp, h); - @<End progress report@>; - if ( mp->internal[mp_tracing_output]>0 ) - mp_print_edges(mp, h," (just shipped out)",true); -} - -@ @<Declarations@>= -static void mp_shipout_backend (MP mp, pointer h); - -@ @c -void mp_shipout_backend (MP mp, pointer h) { - mp_edge_object *hh; /* the first graphical object */ - hh = mp_gr_export(mp,h); - (void)mp_gr_ship_out (hh, - (mp->internal[mp_prologues]/65536), - (mp->internal[mp_procset]/65536), - false); - mp_gr_toss_objects(hh); -} - -@ @<Exported types@>= -typedef void (*mp_backend_writer)(MP, int); - -@ @<Option variables@>= -mp_backend_writer shipout_backend; - -@ Now that we've finished |ship_out|, let's look at the other commands -by which a user can send things to the \.{GF} file. - -@ @<Determine if a character has been shipped out@>= -{ - mp->cur_exp=mp_round_unscaled(mp, mp->cur_exp) % 256; - if ( mp->cur_exp<0 ) mp->cur_exp=mp->cur_exp+256; - boolean_reset(mp->char_exists[mp->cur_exp]); - mp->cur_type=mp_boolean_type; -} - -@ @<Glob...@>= -psout_data ps; - -@ @<Allocate or initialize ...@>= -mp_backend_initialize(mp); - -@ @<Dealloc...@>= -mp_backend_free(mp); - - -@* \[45] Dumping and undumping the tables. -After \.{INIMP} has seen a collection of macros, it -can write all the necessary information on an auxiliary file so -that production versions of \MP\ are able to initialize their -memory at high speed. The present section of the program takes -care of such output and input. We shall consider simultaneously -the processes of storing and restoring, -so that the inverse relation between them is clear. -@.INIMP@> - -The global variable |mem_ident| is a string that is printed right -after the |banner| line when \MP\ is ready to start. For \.{INIMP} this -string says simply `\.{(INIMP)}'; for other versions of \MP\ it says, -for example, `\.{(mem=plain 1990.4.14)}', showing the year, -month, and day that the mem file was created. We have |mem_ident=0| -before \MP's tables are loaded. - -@<Glob...@>= -char * mem_ident; -void * mem_file; /* for input or output of mem information */ - -@ @<Set init...@>= -mp->mem_ident=NULL; - -@ @<Initialize table entries...@>= -mp->mem_ident=xstrdup(" (INIMP)"); - -@ @<Declarations@>= -extern void mp_store_mem_file (MP mp) ; -extern boolean mp_load_mem_file (MP mp); -extern int mp_undump_constants (MP mp); - -@ @<Dealloc variables@>= -xfree(mp->mem_ident); - - -@* \[46] The main program. -This is it: the part of \MP\ that executes all those procedures we have -written. - -Well---almost. We haven't put the parsing subroutines into the -program yet; and we'd better leave space for a few more routines that may -have been forgotten. - -@c @<Declare the basic parsing subroutines@> -@<Declare miscellaneous procedures that were declared |forward|@> - -@ We've noted that there are two versions of \MP. One, called \.{INIMP}, -@.INIMP@> -has to be run first; it initializes everything from scratch, without -reading a mem file, and it has the capability of dumping a mem file. -The other one is called `\.{VIRMP}'; it is a ``virgin'' program that needs -@.VIRMP@> -to input a mem file in order to get started. \.{VIRMP} typically has -a bit more memory capacity than \.{INIMP}, because it does not need the -space consumed by the dumping/undumping routines and the numerous calls on -|primitive|, etc. - -The \.{VIRMP} program cannot read a mem file instantaneously, of course; -the best implementations therefore allow for production versions of \MP\ that -not only avoid the loading routine for object code, they also have -a mem file pre-loaded. - -@ @<Option variables@>= -int ini_version; /* are we iniMP? */ - -@ @<Set |ini_version|@>= -mp->ini_version = (opt->ini_version ? true : false); - -@ The code below make the final chosen hash size the next larger -multiple of 2 from the requested size, and this array is a list of -suitable prime numbers to go with such values. - -The top limit is chosen such that it is definately lower than -|max_halfword-3*param_size|, because |param_size| cannot be larger -than |max_halfword/sizeof(pointer)|. - -@<Declarations@>= -static int mp_prime_choices[] = - { 12289, 24593, 49157, 98317, - 196613, 393241, 786433, 1572869, - 3145739, 6291469, 12582917, 25165843, - 50331653, 100663319 }; - -@ @<Find constant sizes@>= -if (mp->ini_version) { - unsigned i = 14; - set_value(mp->mem_top,opt->main_memory,5000); - mp->mem_max = mp->mem_top; - set_value(mp->param_size,opt->param_size,150); - set_value(mp->max_in_open,opt->max_in_open,10); - if (opt->hash_size>0x8000000) - opt->hash_size=0x8000000; - if (opt->hash_size>0) { - set_value(mp->hash_size,(2*opt->hash_size-1),16384); - } else { - mp->hash_size = 16384; - } - mp->hash_size = mp->hash_size>>i; - while (mp->hash_size>=2) { - mp->hash_size /= 2; - i++; - } - mp->hash_size = mp->hash_size << i; - if (mp->hash_size>0x8000000) - mp->hash_size=0x8000000; - mp->hash_prime=mp_prime_choices[(i-14)]; -} else { - int i = -1; - if (mp->mem_name == NULL) { - mp->mem_name = mp_xstrdup(mp,"plain"); - } - if (mp_open_mem_file(mp)) { - char *sfile = NULL; - i = mp_undump_constants(mp); - if (i != metapost_magic) - goto OFF_BASE; - set_value(mp->mem_max,opt->main_memory,mp->mem_top); - goto DONE; -OFF_BASE: - wterm_ln("(Fatal mem file error; "); - sfile = (mp->find_file)(mp, mp->mem_name, "r", mp_filetype_memfile); - if (sfile!=NULL) wterm(sfile); - if (i>metapost_old_magic && i<metapost_magic) { - wterm(" was written by an older version)\n"); - } else { - wterm(" appears not to be a mem file)\n"); - } - } - mp->history = mp_fatal_error_stop; - mp_jump_out(mp); -} -DONE: - - -@ Here we do whatever is needed to complete \MP's job gracefully on the -local operating system. The code here might come into play after a fatal -error; it must therefore consist entirely of ``safe'' operations that -cannot produce error messages. For example, it would be a mistake to call -|str_room| or |make_string| at this time, because a call on |overflow| -might lead to an infinite loop. -@^system dependencies@> - -This program doesn't bother to close the input files that may still be open. - -@ @c -void mp_close_files_and_terminate (MP mp) { - integer k; /* all-purpose index */ - integer LH; /* the length of the \.{TFM} header, in words */ - int lk_offset; /* extra words inserted at beginning of |lig_kern| array */ - pointer p; /* runs through a list of \.{TFM} dimensions */ - if (mp->finished) - return; - @<Close all open files in the |rd_file| and |wr_file| arrays@>; - if ( mp->internal[mp_tracing_stats]>0 ) - @<Output statistics about this job@>; - wake_up_terminal; - @<Do all the finishing work on the \.{TFM} file@>; - @<Explain what output files were written@>; - if ( mp->log_opened && ! mp->noninteractive ){ - wlog_cr; - (mp->close_file)(mp,mp->log_file); - mp->selector=mp->selector-2; - if ( mp->selector==term_only ) { - mp_print_nl(mp, "Transcript written on "); -@.Transcript written...@> - mp_print(mp, mp->log_name); mp_print_char(mp, xord('.')); - } - } - mp_print_ln(mp); - mp->finished = true; -} - -@ @<Declarations@>= -static void mp_close_files_and_terminate (MP mp) ; - -@ @<Close all open files in the |rd_file| and |wr_file| arrays@>= -if (mp->rd_fname!=NULL) { - for (k=0;k<(int)mp->read_files;k++ ) { - if ( mp->rd_fname[k]!=NULL ) { - (mp->close_file)(mp,mp->rd_file[k]); - xfree(mp->rd_fname[k]); - } - } -} -if (mp->wr_fname!=NULL) { - for (k=0;k<(int)mp->write_files;k++) { - if ( mp->wr_fname[k]!=NULL ) { - (mp->close_file)(mp,mp->wr_file[k]); - xfree(mp->wr_fname[k]); - } - } -} - -@ @<Dealloc ...@>= -for (k=0;k<(int)mp->max_read_files;k++ ) { - if ( mp->rd_fname[k]!=NULL ) { - (mp->close_file)(mp,mp->rd_file[k]); - xfree(mp->rd_fname[k]); - } -} -xfree(mp->rd_file); -xfree(mp->rd_fname); -for (k=0;k<(int)mp->max_write_files;k++) { - if ( mp->wr_fname[k]!=NULL ) { - (mp->close_file)(mp,mp->wr_file[k]); - xfree(mp->wr_fname[k]); - } -} -xfree(mp->wr_file); -xfree(mp->wr_fname); - - -@ We want to produce a \.{TFM} file if and only if |mp_fontmaking| is positive. - -We reclaim all of the variable-size memory at this point, so that -there is no chance of another memory overflow after the memory capacity -has already been exceeded. - -@<Do all the finishing work on the \.{TFM} file@>= -if ( mp->internal[mp_fontmaking]>0 ) { - @<Make the dynamic memory into one big available node@>; - @<Massage the \.{TFM} widths@>; - mp_fix_design_size(mp); mp_fix_check_sum(mp); - @<Massage the \.{TFM} heights, depths, and italic corrections@>; - mp->internal[mp_fontmaking]=0; /* avoid loop in case of fatal error */ - @<Finish the \.{TFM} file@>; -} - -@ @<Make the dynamic memory into one big available node@>= -mp->rover=lo_mem_stat_max+1; mp_link(mp->rover)=empty_flag; mp->lo_mem_max=mp->hi_mem_min-1; -if ( mp->lo_mem_max-mp->rover>max_halfword ) mp->lo_mem_max=max_halfword+mp->rover; -node_size(mp->rover)=mp->lo_mem_max-mp->rover; -lmp_link(mp->rover)=mp->rover; rmp_link(mp->rover)=mp->rover; -mp_link(mp->lo_mem_max)=null; mp_info(mp->lo_mem_max)=null - -@ The present section goes directly to the log file instead of using -|print| commands, because there's no need for these strings to take -up |str_pool| memory when a non-{\bf stat} version of \MP\ is being used. - -@<Output statistics...@>= -if ( mp->log_opened ) { - char s[128]; - wlog_ln(" "); - wlog_ln("Here is how much of MetaPost's memory you used:"); -@.Here is how much...@> - mp_snprintf(s,128," %i string%s out of %i",(int)mp->max_strs_used-mp->init_str_use, - (mp->max_strs_used!=mp->init_str_use+1 ? "s" : ""), - (int)(mp->max_strings-1-mp->init_str_use)); - wlog_ln(s); - mp_snprintf(s,128," %i string characters out of %i", - (int)mp->max_pl_used-mp->init_pool_ptr, - (int)mp->pool_size-mp->init_pool_ptr); - wlog_ln(s); - mp_snprintf(s,128," %i words of memory out of %i", - (int)mp->lo_mem_max+mp->mem_end-mp->hi_mem_min+2, - (int)mp->mem_end); - wlog_ln(s); - mp_snprintf(s,128," %i symbolic tokens out of %i", (int)mp->st_count, (int)mp->hash_size); - wlog_ln(s); - mp_snprintf(s,128," %ii,%in,%ip,%ib stack positions out of %ii,%in,%ip,%ib", - (int)mp->max_in_stack,(int)mp->int_ptr, - (int)mp->max_param_stack,(int)mp->max_buf_stack+1, - (int)mp->stack_size,(int)mp->max_internal,(int)mp->param_size,(int)mp->buf_size); - wlog_ln(s); - mp_snprintf(s,128," %i string compactions (moved %i characters, %i strings)", - (int)mp->pact_count,(int)mp->pact_chars,(int)mp->pact_strs); - wlog_ln(s); -} - -@ It is nice to have have some of the stats available from the API. - -@<Exported function ...@>= -int mp_memory_usage (MP mp ); -int mp_hash_usage (MP mp ); -int mp_param_usage (MP mp ); -int mp_open_usage (MP mp ); - -@ @c -int mp_memory_usage (MP mp ) { - return (int)mp->lo_mem_max+mp->mem_end-mp->hi_mem_min+2; -} -int mp_hash_usage (MP mp ) { - return (int)mp->st_count; -} -int mp_param_usage (MP mp ) { - return (int)mp->max_param_stack; -} -int mp_open_usage (MP mp ) { - return (int)mp->max_in_stack; -} - -@ We get to the |final_cleanup| routine when \&{end} or \&{dump} has -been scanned. - -@c -void mp_final_cleanup (MP mp) { - quarterword c; /* 0 for \&{end}, 1 for \&{dump} */ - c=mp->cur_mod; - if ( mp->job_name==NULL ) mp_open_log_file(mp); - while ( mp->input_ptr>0 ) { - if ( token_state ) mp_end_token_list(mp); - else mp_end_file_reading(mp); - } - while ( mp->loop_ptr!=null ) mp_stop_iteration(mp); - while ( mp->open_parens>0 ) { - mp_print(mp, " )"); decr(mp->open_parens); - }; - while ( mp->cond_ptr!=null ) { - mp_print_nl(mp, "(end occurred when "); -@.end occurred...@> - mp_print_cmd_mod(mp, fi_or_else,mp->cur_if); - /* `\.{if}' or `\.{elseif}' or `\.{else}' */ - if ( mp->if_line!=0 ) { - mp_print(mp, " on line "); mp_print_int(mp, mp->if_line); - } - mp_print(mp, " was incomplete)"); - mp->if_line=if_line_field(mp->cond_ptr); - mp->cur_if=mp_name_type(mp->cond_ptr); mp->cond_ptr=mp_link(mp->cond_ptr); - } - if ( mp->history!=mp_spotless ) - if ( ((mp->history==mp_warning_issued)||(mp->interaction<mp_error_stop_mode)) ) - if ( mp->selector==term_and_log ) { - mp->selector=term_only; - mp_print_nl(mp, "(see the transcript file for additional information)"); -@.see the transcript file...@> - mp->selector=term_and_log; - } - if ( c==1 ) { - if (mp->ini_version) { - mp_store_mem_file(mp); return; - } - mp_print_nl(mp, "(dump is performed only by INIMP)"); return; -@.dump...only by INIMP@> - } -} - -@ @<Declarations@>= -static void mp_final_cleanup (MP mp) ; -static void mp_init_prim (MP mp) ; -static void mp_init_tab (MP mp) ; - -@ @c -void mp_init_prim (MP mp) { /* initialize all the primitives */ - @<Put each...@>; -} -@# -void mp_init_tab (MP mp) { /* initialize other tables */ - integer k; /* all-purpose index */ - @<Initialize table entries (done by \.{INIMP} only)@>; -} - - -@ When we begin the following code, \MP's tables may still contain garbage; -thus we must proceed cautiously to get bootstrapped in. - -But when we finish this part of the program, \MP\ is ready to call on the -|main_control| routine to do its work. - -@<Get the first line...@>= -{ - @<Initialize the input routines@>; - if (mp->mem_ident==NULL) { - if ( ! mp_load_mem_file(mp) ) { - (mp->close_file)(mp, mp->mem_file); - mp->history = mp_fatal_error_stop; - return mp; - } - (mp->close_file)(mp, mp->mem_file); - } - @<Initializations following first line@>; -} - -@ @<Initializations following first line@>= - mp->buffer[limit]=(ASCII_code)'%'; - mp_fix_date_and_time(mp); - if (mp->random_seed==0) - mp->random_seed = (mp->internal[mp_time] / unity)+mp->internal[mp_day]; - mp_init_randoms(mp, mp->random_seed); - @<Initialize the print |selector|...@>; - if ( loc<limit ) if ( mp->buffer[loc]!='\\' ) - mp_start_input(mp); /* \&{input} assumed */ - -@ @<Run inimpost commands@>= -{ - mp_get_strings_started(mp); - mp_init_tab(mp); /* initialize the tables */ - mp_init_prim(mp); /* call |primitive| for each primitive */ - mp->init_str_use=mp->max_str_ptr=mp->str_ptr; - mp->init_pool_ptr=mp->max_pool_ptr=mp->pool_ptr; - mp_fix_date_and_time(mp); -} - -@ Saving the filename template - -@<Save the filename template@>= -{ - if ( mp->filename_template!=0 ) delete_str_ref(mp->filename_template); - if ( length(mp->cur_exp)==0 ) mp->filename_template=0; - else { - mp->filename_template=mp->cur_exp; add_str_ref(mp->filename_template); - } -} - -@* \[47] Debugging. - - -@* \[48] System-dependent changes. -This section should be replaced, if necessary, by any special -modification of the program -that are necessary to make \MP\ work at a particular installation. -It is usually best to design your change file so that all changes to -previous sections preserve the section numbering; then everybody's version -will be consistent with the published program. More extensive changes, -which introduce new sections, can be inserted here; then only the index -itself will get a new section number. -@^system dependencies@> - -@* \[49] Index. -Here is where you can find all uses of each identifier in the program, -with underlined entries pointing to where the identifier was defined. -If the identifier is only one letter long, however, you get to see only -the underlined entries. {\sl All references are to section numbers instead of -page numbers.} - -This index also lists error messages and other aspects of the program -that you might want to look up some day. For example, the entry -for ``system dependencies'' lists all sections that should receive -special attention from people who are installing \MP\ in a new -operating environment. A list of various things that can't happen appears -under ``this can't happen''. -Approximately 25 sections are listed under ``inner loop''; these account -for more than 60\pct! of \MP's running time, exclusive of input and output. diff --git a/Build/source/texk/web2c/luatexdir/mp/psout.w b/Build/source/texk/web2c/luatexdir/mp/psout.w deleted file mode 100644 index d3a2bb682e7..00000000000 --- a/Build/source/texk/web2c/luatexdir/mp/psout.w +++ /dev/null @@ -1,5703 +0,0 @@ -% $Id: psout.w 804 2008-12-23 15:22:15Z taco $ -% -% Copyright 2008 Taco Hoekwater. -% -% This program is free software: you can redistribute it and/or modify -% it under the terms of the GNU General Public License as published by -% the Free Software Foundation, either version 2 of the License, or -% (at your option) any later version. -% -% This program is distributed in the hope that it will be useful, -% but WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -% GNU General Public License for more details. -% -% You should have received a copy of the GNU General Public License -% along with this program. If not, see <http://www.gnu.org/licenses/>. -% -% TeX is a trademark of the American Mathematical Society. -% METAFONT is a trademark of Addison-Wesley Publishing Company. -% PostScript is a trademark of Adobe Systems Incorporated. - -% Here is TeX material that gets inserted after \input webmac -\def\hang{\hangindent 3em\noindent\ignorespaces} -\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces} -\def\PASCAL{Pascal} -\def\ps{PostScript} -\def\ph{\hbox{Pascal-H}} -\def\psqrt#1{\sqrt{\mathstrut#1}} -\def\k{_{k+1}} -\def\pct!{{\char`\%}} % percent sign in ordinary text -\font\tenlogo=logo10 % font used for the METAFONT logo -\font\logos=logosl10 -\def\MF{{\tenlogo META}\-{\tenlogo FONT}} -\def\MP{{\tenlogo META}\-{\tenlogo POST}} -\def\<#1>{$\langle#1\rangle$} -\def\section{\mathhexbox278} -\let\swap=\leftrightarrow -\def\round{\mathop{\rm round}\nolimits} -\mathchardef\vbv="026A % synonym for `\|' -\def\vb{\relax\ifmmode\vbv\else$\vbv$\fi} -\def\[#1]{} % from pascal web -\def\(#1){} % this is used to make section names sort themselves better -\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@> - -\let\?=\relax % we want to be able to \write a \? - -\def\title{MetaPost \ps\ output} -\def\topofcontents{\hsize 5.5in - \vglue -30pt plus 1fil minus 1.5in - \def\?##1]{\hbox to 1in{\hfil##1.\ }} - } -\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in} -\pdfoutput=1 -\pageno=3 - -@ -@d true 1 -@d false 0 -@d null_font 0 -@d null 0 -@d unity 0200000 /* $2^{16}$, represents 1.00000 */ -@d el_gordo 017777777777 /* $2^{31}-1$, the largest value that \MP\ likes */ -@d incr(A) (A)=(A)+1 /* increase a variable by unity */ -@d decr(A) (A)=(A)-1 /* decrease a variable by unity */ -@d negate(A) (A)=-(A) /* change the sign of a variable */ -@d odd(A) ((A)%2==1) -@d half(A) ((A)/2) -@d print_err(A) mp_print_err(mp,(A)) -@d max_quarterword 0x3FFF /* largest allowable value in a |quarterword| */ - -@c -#include "config.h" -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include <stdarg.h> -#include <assert.h> -#include "avl.h" -#include "mplib.h" -#include "mplibps.h" /* external header */ -#include "mpmp.h" /* internal header */ -#include "mppsout.h" /* internal header */ -@h -@<Declarations@> -@<Static variables in the outer block@> - -@ There is a small bit of code from the backend that bleads through -to the frontend because I do not know how to set up the includes -properly. Those are the definitions of |struct libavl_allocator| -and |typedef struct psout_data_struct * psout_data|. - -The |libavl_allocator| is a trick that makes sure that frontends -do not need |avl.h|, and the |psout_data| is needed for the backend -data structure. - -@ @(mppsout.h@>= -@<Types...@> -typedef struct psout_data_struct { - @<Globals@> -} psout_data_struct ; -@<Exported function headers@> - -@ @c -static boolean mp_isdigit (int a) { - return (a>='0'&&a<='9'); -} -static int mp_tolower (int a) { - if (a>='A' && a <='Z') - return a - 'A' + 'a'; - return a; -} -static int mp_strcasecmp (const char *s1, const char *s2) { - int r; - char *ss1, *ss2, *c; - ss1 = mp_strdup(s1); - c = ss1; - while (*c != '\0') { - *c = mp_tolower(*c); c++; - } - ss2 = mp_strdup(s2); - c = ss2; - while (*c != '\0') { - *c = mp_tolower(*c); c++; - } - r = strcmp(ss1,ss2); - free (ss1); free(ss2); - return r; -} - -@ @<Exported function headers@>= -void mp_backend_initialize (MP mp) ; -void mp_backend_free (MP mp) ; - -@ -@c void mp_backend_initialize (MP mp) { - mp->ps = mp_xmalloc(mp,1,sizeof(psout_data_struct)); - @<Set initial values@>; -} -void mp_backend_free (MP mp) { - @<Dealloc variables@>; - enc_free(mp); - t1_free(mp); - fm_free(mp); - mp_xfree(mp->ps); - mp->ps = NULL; -} - -@ Writing to ps files - -@<Globals@>= -integer ps_offset; - /* the number of characters on the current \ps\ file line */ - -@ @<Set initial values@>= -mp->ps->ps_offset = 0; - -@ - -@d wps(A) (mp->write_ascii_file)(mp,mp->ps_file,(A)) -@d wps_chr(A) do { - char ss[2]; - ss[0]=(A); ss[1]=0; - (mp->write_ascii_file)(mp,mp->ps_file,(char *)ss); -} while (0) -@d wps_cr (mp->write_ascii_file)(mp,mp->ps_file,"\n") -@d wps_ln(A) { wterm_cr; (mp->write_ascii_file)(mp,mp->ps_file,(A)); } - -@c -static void mp_ps_print_ln (MP mp) { /* prints an end-of-line */ - wps_cr; - mp->ps->ps_offset=0; -} - -@ @c -static void mp_ps_print_char (MP mp, int s) { /* prints a single character */ - if ( s==13 ) { - wps_cr; mp->ps->ps_offset=0; - } else { - wps_chr(s); incr(mp->ps->ps_offset); - } -} - -@ @c -static void mp_ps_do_print (MP mp, const char *ss, size_t len) { /* prints string |s| */ - size_t j = 0; - while ( j<len ){ - mp_ps_print_char(mp, ss[j]); incr(j); - } -} - -@ Deciding where to break the ps output line. - -@d ps_room(A) if (mp->ps->ps_offset>0 && (mp->ps->ps_offset+(int)(A))>mp->max_print_line ) { - mp_ps_print_ln(mp); /* optional line break */ -} - -@c -static void mp_ps_print (MP mp, const char *ss) { - ps_room(strlen(ss)); - mp_ps_do_print(mp, ss, strlen(ss)); -} - -@ The procedure |print_nl| is like |print|, but it makes sure that the -string appears at the beginning of a new line. - -@c -static void mp_ps_print_nl (MP mp, const char *s) { /* prints string |s| at beginning of line */ - if ( mp->ps->ps_offset>0 ) mp_ps_print_ln(mp); - mp_ps_print(mp, s); -} - -@ An array of digits in the range |0..9| is printed by |print_the_digs|. - -@c -static void mp_ps_print_the_digs (MP mp, int k) { - /* prints |dig[k-1]|$\,\ldots\,$|dig[0]| */ - while ( k-->0 ){ - mp_ps_print_char(mp, '0'+mp->dig[k]); - } -} - -@ The following procedure, which prints out the decimal representation of a -given integer |n|, has been written carefully so that it works properly -if |n=0| or if |(-n)| would cause overflow. It does not apply |mod| or |div| -to negative arguments, since such operations are not implemented consistently -by all \PASCAL\ compilers. - -@c -static void mp_ps_print_int (MP mp,integer n) { /* prints an integer in decimal form */ - integer m; /* used to negate |n| in possibly dangerous cases */ - int k = 0; /* index to current digit; we assume that $|n|<10^{23}$ */ - if ( n<0 ) { - mp_ps_print_char(mp, '-'); - if ( n>-100000000 ) { - negate(n); - } else { - m=-1-n; n=m / 10; m=(m % 10)+1; k=1; - if ( m<10 ) { - mp->dig[0]=(unsigned char)m; - } else { - mp->dig[0]=0; incr(n); - } - } - } - do { - mp->dig[k]=(unsigned char)(n % 10); n=n / 10; incr(k); - } while (n!=0); - mp_ps_print_the_digs(mp, k); -} - -@ \MP\ also makes use of a trivial procedure to print two digits. The -following subroutine is usually called with a parameter in the range |0<=n<=99|. - -@c -static void mp_ps_print_dd (MP mp,integer n) { /* prints two least significant digits */ - n=abs(n) % 100; - mp_ps_print_char(mp, '0'+(n / 10)); - mp_ps_print_char(mp, '0'+(n % 10)); -} - -@ Conversely, here is a procedure analogous to |print_int|. If the output -of this procedure is subsequently read by \MP\ and converted by the -|round_decimals| routine above, it turns out that the original value will -be reproduced exactly. A decimal point is printed only if the value is -not an integer. If there is more than one way to print the result with -the optimum number of digits following the decimal point, the closest -possible value is given. - -The invariant relation in the \&{repeat} loop is that a sequence of -decimal digits yet to be printed will yield the original number if and only if -they form a fraction~$f$ in the range $s-\delta\L10\cdot2^{16}f<s$. -We can stop if and only if $f=0$ satisfies this condition; the loop will -terminate before $s$ can possibly become zero. - -@c -static void mp_ps_print_scaled (MP mp,scaled s) { - scaled delta; /* amount of allowable inaccuracy */ - if ( s<0 ) { - mp_ps_print_char(mp, '-'); - negate(s); /* print the sign, if negative */ - } - mp_ps_print_int(mp, s / unity); /* print the integer part */ - s=10*(s % unity)+5; - if ( s!=5 ) { - delta=10; - mp_ps_print_char(mp, '.'); - do { - if ( delta>unity ) - s=s+0100000-(delta / 2); /* round the final digit */ - mp_ps_print_char(mp, '0'+(s / unity)); - s=10*(s % unity); - delta=delta*10; - } while (s>delta); - } -} - - -@* \[44a] Dealing with font encodings. - -First, here are a few helpers for parsing files - -@d check_buf(size, buf_size) - if ((unsigned)(size) > (unsigned)(buf_size)) { - char S[128]; - mp_snprintf(S,128,"buffer overflow: (%u,%u) at file %s, line %d", - (unsigned)(size),(unsigned)(buf_size), __FILE__, __LINE__ ); - mp_fatal_error(mp,S); - } - -@d append_char_to_buf(c, p, buf, buf_size) do { - if (c == 9) - c = 32; - if (c == 13 || c == EOF) - c = 10; - if (c != ' ' || (p > buf && p[-1] != 32)) { - check_buf(p - buf + 1, (buf_size)); - *p++ = c; - } -} while (0) - -@d append_eol(p, buf, buf_size) do { - check_buf(p - buf + 2, (buf_size)); - if (p - buf > 1 && p[-1] != 10) - *p++ = 10; - if (p - buf > 2 && p[-2] == 32) { - p[-2] = 10; - p--; - } - *p = 0; -} while (0) - -@d remove_eol(p, buf) do { - p = strend(buf) - 1; - if (*p == 10) - *p = 0; -} while (0) - -@d skip(p, c) if (*p == c) p++ -@d strend(s) strchr(s, 0) -@d str_prefix(s1, s2) (strncmp((s1), (s2), strlen(s2)) == 0) - - -@ @<Types...@>= -typedef struct { - boolean loaded; /* the encoding has been loaded? */ - char *file_name; /* encoding file name */ - char *enc_name; /* encoding true name */ - integer objnum; /* object number */ - char **glyph_names; - integer tounicode; /* object number of associated ToUnicode entry */ -} enc_entry; - - -@ - -@d ENC_STANDARD 0 -@d ENC_BUILTIN 1 - -@<Glob...@>= -#define ENC_BUF_SIZE 0x1000 -char enc_line[ENC_BUF_SIZE]; -void * enc_file; - -@ -@d enc_eof() (mp->eof_file)(mp,mp->ps->enc_file) -@d enc_close() (mp->close_file)(mp,mp->ps->enc_file) - -@c -static int enc_getchar(MP mp) { - size_t len = 1; - unsigned char abyte=0; - void *byte_ptr = &abyte; - (mp->read_binary_file)(mp,mp->ps->enc_file,&byte_ptr,&len); - return abyte; -} - -@ @c -static boolean mp_enc_open (MP mp, char *n) { - mp->ps->enc_file=(mp->open_file)(mp,n, "r", mp_filetype_encoding); - if (mp->ps->enc_file!=NULL) - return true; - else - return false; -} -static void mp_enc_getline (MP mp) { - char *p; - int c; -RESTART: - if (enc_eof ()) { - print_err("unexpected end of file"); - mp_error(mp); - } - p = mp->ps->enc_line; - do { - c = enc_getchar (mp); - append_char_to_buf (c, p, mp->ps->enc_line, ENC_BUF_SIZE); - } while (c != 10); - append_eol (p, mp->ps->enc_line, ENC_BUF_SIZE); - if (p - mp->ps->enc_line < 2 || *mp->ps->enc_line == '%') - goto RESTART; -} -static void mp_load_enc (MP mp, char *enc_name, - char **enc_encname, char **glyph_names){ - char buf[ENC_BUF_SIZE], *p, *r; - int names_count; - char *myname; - unsigned save_selector = mp->selector; - if (!mp_enc_open (mp,enc_name)) { - mp_print (mp,"cannot open encoding file for reading"); - return; - } - mp_normalize_selector(mp); - mp_print (mp,"{"); - mp_print (mp, enc_name); - mp_enc_getline (mp); - if (*mp->ps->enc_line != '/' || (r = strchr (mp->ps->enc_line, '[')) == NULL) { - remove_eol (r, mp->ps->enc_line); - print_err ("invalid encoding vector (a name or `[' missing): `"); - mp_print(mp,mp->ps->enc_line); - mp_print(mp,"'"); - mp_error(mp); - } - while (*(r-1)==' ') r--; /* strip trailing spaces from encoding name */ - myname = mp_xmalloc(mp,r-mp->ps->enc_line,1); - memcpy(myname,mp->ps->enc_line+1,(r-mp->ps->enc_line)-1); - *(myname+(r-mp->ps->enc_line-1))=0; - *enc_encname = myname; - while (*r!='[') r++; - r++; /* skip '[' */ - names_count = 0; - skip (r, ' '); - for (;;) { - while (*r == '/') { - for (p = buf, r++; - *r != ' ' && *r != 10 && *r != ']' && *r != '/'; *p++ = *r++); - *p = 0; - skip (r, ' '); - if (names_count > 256) { - print_err ("encoding vector contains more than 256 names"); - mp_error(mp); - } - if (mp_xstrcmp (buf, notdef) != 0) - glyph_names[names_count] = mp_xstrdup (mp,buf); - names_count++; - } - if (*r != 10 && *r != '%') { - if (str_prefix (r, "] def")) - goto DONE; - else { - remove_eol (r, mp->ps->enc_line); - print_err - ("invalid encoding vector: a name or `] def' expected: `"); - mp_print(mp,mp->ps->enc_line); - mp_print(mp,"'"); - mp_error(mp); - } - } - mp_enc_getline (mp); - r = mp->ps->enc_line; - } -DONE: - enc_close (); - mp_print (mp,"}"); - mp->selector = save_selector; -} -static void mp_read_enc (MP mp, enc_entry * e) { - if (e->loaded) - return; - e->enc_name = NULL; - mp_load_enc (mp,e->file_name, &e->enc_name, e->glyph_names); - e->loaded = true; -} - -@ |write_enc| is used to write either external encoding (given in map file) or - internal encoding (read from the font file); - the 2nd argument is a pointer to the encoding entry; - -@c -static void mp_write_enc (MP mp, enc_entry * e) { - int i; - size_t s, foffset; - char **g; - if (e->objnum != 0) /* the encoding has been written already */ - return; - e->objnum = 1; - g = e->glyph_names; - - mp_ps_print(mp,"\n%%%%BeginResource: encoding "); - mp_ps_print(mp, e->enc_name); - mp_ps_print_nl(mp, "/"); - mp_ps_print(mp, e->enc_name); - mp_ps_print(mp, " [ "); - mp_ps_print_ln (mp); - foffset = strlen(e->file_name)+3; - for (i = 0; i < 256; i++) { - s = strlen(g[i]); - if (s+1+foffset>=80) { - mp_ps_print_ln (mp); - foffset = 0; - } - foffset += s+2; - mp_ps_print_char(mp,'/'); - mp_ps_print(mp, g[i]); - mp_ps_print_char(mp,' '); - } - if (foffset>75) - mp_ps_print_ln (mp); - mp_ps_print_nl (mp,"] def\n"); - mp_ps_print(mp,"%%%%EndResource"); -} - - -@ All encoding entries go into AVL tree for fast search by name. - -@<Glob...@>= -struct avl_table *enc_tree; - -@ Memory management functions for avl - -@<Static variables in the outer block@>= -static const char notdef[] = ".notdef"; - -@ @<Declarations@>= -static void *avl_xmalloc (struct libavl_allocator *allocator, size_t size); -static void avl_xfree (struct libavl_allocator *allocator, void *block); - -@ @c -static void *avl_xmalloc (struct libavl_allocator *allocator, size_t size) { - (void)allocator; - return malloc (size); -} -static void avl_xfree (struct libavl_allocator *allocator, void *block) { - (void)allocator; - free (block); -} - -@ @<Glob...@>= -struct libavl_allocator avl_xallocator; - -@ @<Set initial...@>= -mp->ps->avl_xallocator.libavl_malloc=avl_xmalloc; -mp->ps->avl_xallocator.libavl_free= avl_xfree; -mp->ps->enc_tree = NULL; - -@ @c -static int comp_enc_entry (const void *pa, const void *pb, void *p) { - (void)p; - return strcmp (((const enc_entry *) pa)->file_name, - ((const enc_entry *) pb)->file_name); -} -static enc_entry * mp_add_enc (MP mp, char *s) { - int i; - enc_entry tmp, *p; - void **aa; - if (mp->ps->enc_tree == NULL) { - mp->ps->enc_tree = avl_create (comp_enc_entry, NULL, &mp->ps->avl_xallocator); - } - tmp.file_name = s; - p = (enc_entry *) avl_find (mp->ps->enc_tree, &tmp); - if (p != NULL) /* encoding already registered */ - return p; - p = mp_xmalloc (mp,1,sizeof (enc_entry)); - p->loaded = false; - p->file_name = mp_xstrdup (mp,s); - p->objnum = 0; - p->tounicode = 0; - p->glyph_names = mp_xmalloc (mp,256,sizeof (char *)); - for (i = 0; i < 256; i++) - p->glyph_names[i] = (char *) notdef; - aa = avl_probe (mp->ps->enc_tree, p); - return p; -} - -@ cleaning up... - -@c -static void mp_destroy_enc_entry (void *pa, void *pb) { - enc_entry *p; - int i; - p = (enc_entry *) pa; - (void)pb; - mp_xfree (p->file_name); - if (p->glyph_names != NULL) - for (i = 0; i < 256; i++) - if (p->glyph_names[i] != notdef) - mp_xfree (p->glyph_names[i]); - mp_xfree (p->glyph_names); - mp_xfree (p); -} - -@ @<Declarations@>= -static void enc_free (MP mp); - -@ @c static void enc_free (MP mp) { - if (mp->ps->enc_tree != NULL) - avl_destroy (mp->ps->enc_tree, mp_destroy_enc_entry); -} - -@ @<Declarations@>= -static void mp_reload_encodings (MP mp) ; -static void mp_font_encodings (MP mp, font_number lastfnum, boolean encodings_only) ; - -@ @c void mp_reload_encodings (MP mp) { - font_number f; - enc_entry *e; - fm_entry *fm_cur; - font_number lastfnum = mp->last_fnum; - for (f=null_font+1;f<=lastfnum;f++) { - if (mp->font_enc_name[f]!=NULL ) { - mp_xfree(mp->font_enc_name[f]); - mp->font_enc_name[f]=NULL; - } - if (mp_has_fm_entry (mp,f,&fm_cur)) { - if (fm_cur != NULL && fm_cur->ps_name != NULL &&is_reencoded (fm_cur)) { - e = fm_cur->encoding; - mp_read_enc (mp,e); - } - } - } -} -static void mp_font_encodings (MP mp, font_number lastfnum, boolean encodings_only) { - font_number f; - enc_entry *e; - fm_entry *fm; - for (f=null_font+1;f<=lastfnum;f++) { - if (mp_has_font_size(mp,f) && mp_has_fm_entry (mp,f, &fm)) { - if (fm != NULL && (fm->ps_name != NULL)) { - if (is_reencoded (fm)) { - if (encodings_only || (!is_subsetted (fm))) { - e = fm->encoding; - mp_write_enc (mp, e); - /* clear for next run */ - e->objnum = 0; - } - } - } - } - } -} - -@* \[44b] Parsing font map files. - -@d FM_BUF_SIZE 1024 - -@<Glob...@>= -void * fm_file; - -@ -@d fm_close() (mp->close_file)(mp,mp->ps->fm_file) -@d fm_eof() (mp->eof_file)(mp,mp->ps->fm_file) - -@c -static int fm_getchar(MP mp) { - size_t len = 1; - unsigned char abyte=0; - void *byte_ptr = &abyte; - (mp->read_binary_file)(mp,mp->ps->fm_file,&byte_ptr,&len); - if (len==0) - return EOF; - return abyte; -} - - -@ @<Types...@>= -enum _mode { FM_DUPIGNORE, FM_REPLACE, FM_DELETE }; -enum _ltype { MAPFILE, MAPLINE }; -enum _tfmavail { TFM_UNCHECKED, TFM_FOUND, TFM_NOTFOUND }; -typedef struct mitem { - int mode; /* |FM_DUPIGNORE| or |FM_REPLACE| or |FM_DELETE| */ - int type; /* map file or map line */ - char *map_line; /* pointer to map file name or map line */ - int lineno; /* line number in map file */ -} mapitem; - -@ @<Glob...@>= -mapitem *mitem; -fm_entry *fm_cur; -fm_entry *loaded_tfm_found; -fm_entry *avail_tfm_found; -fm_entry *non_tfm_found; -fm_entry *not_avail_tfm_found; - -@ @<Set initial...@>= -mp->ps->mitem = NULL; - -@ @<Declarations@>= -static const char nontfm[] = "<nontfm>"; - -@ -@d read_field(r, q, buf) do { - q = buf; - while (*r != ' ' && *r != '\0') - *q++ = *r++; - *q = '\0'; - skip (r, ' '); -} while (0) - -@d set_field(F) do { - if (q > buf) - fm->F = mp_xstrdup(mp,buf); - if (*r == '\0') - goto DONE; -} while (0) - -@d cmp_return(a, b) - if (a > b) - return 1; - if (a < b) - return -1 - -@c -static fm_entry *new_fm_entry (MP mp) { - fm_entry *fm; - fm = mp_xmalloc (mp,1,sizeof(fm_entry)); - fm->tfm_name = NULL; - fm->ps_name = NULL; - fm->flags = 4; - fm->ff_name = NULL; - fm->subset_tag = NULL; - fm->encoding = NULL; - fm->tfm_num = null_font; - fm->tfm_avail = TFM_UNCHECKED; - fm->type = 0; - fm->slant = 0; - fm->extend = 0; - fm->ff_objnum = 0; - fm->fn_objnum = 0; - fm->fd_objnum = 0; - fm->charset = NULL; - fm->all_glyphs = false; - fm->links = 0; - fm->pid = -1; - fm->eid = -1; - return fm; -} - -static void delete_fm_entry (fm_entry * fm) { - mp_xfree (fm->tfm_name); - mp_xfree (fm->ps_name); - mp_xfree (fm->ff_name); - mp_xfree (fm->subset_tag); - mp_xfree (fm->charset); - mp_xfree (fm); -} - -static ff_entry *new_ff_entry (MP mp) { - ff_entry *ff; - ff = mp_xmalloc (mp,1,sizeof(ff_entry)); - ff->ff_name = NULL; - ff->ff_path = NULL; - return ff; -} - -static void delete_ff_entry (ff_entry * ff) { - mp_xfree (ff->ff_name); - mp_xfree (ff->ff_path); - mp_xfree (ff); -} - -static char *mk_base_tfm (MP mp, char *tfmname, int *i) { - static char buf[SMALL_BUF_SIZE]; - char *p = tfmname, *r = strend (p) - 1, *q = r; - while (q > p && mp_isdigit (*q)) - --q; - if (!(q > p) || q == r || (*q != '+' && *q != '-')) - return NULL; - check_buf (q - p + 1, SMALL_BUF_SIZE); - strncpy (buf, p, (size_t) (q - p)); - buf[q - p] = '\0'; - *i = atoi (q); - return buf; -} - -@ @<Declarations@>= -static boolean mp_has_fm_entry (MP mp,font_number f, fm_entry **fm); - -@ @c -boolean mp_has_fm_entry (MP mp,font_number f, fm_entry **fm) { - fm_entry *res = NULL; - res = mp_fm_lookup (mp, f); - if (fm != NULL) { - *fm =res; - } - return (res != NULL); -} - -@ @<Glob...@>= -struct avl_table *tfm_tree; -struct avl_table *ps_tree; -struct avl_table *ff_tree; - -@ @<Set initial...@>= -mp->ps->tfm_tree = NULL; -mp->ps->ps_tree = NULL; -mp->ps->ff_tree = NULL; - -@ AVL sort |fm_entry| into |tfm_tree| by |tfm_name | - -@c -static int comp_fm_entry_tfm (const void *pa, const void *pb, void *p) { - (void)p; - return strcmp (((const fm_entry *) pa)->tfm_name, - ((const fm_entry *) pb)->tfm_name); -} - -@ AVL sort |fm_entry| into |ps_tree| by |ps_name|, |slant|, and |extend| - -@c static int comp_fm_entry_ps (const void *pa, const void *pb, void *p) { - int i; - const fm_entry *p1 = (const fm_entry *) pa; - const fm_entry *p2 = (const fm_entry *) pb; - (void)p; - assert (p1->ps_name != NULL && p2->ps_name != NULL); - if ((i = strcmp (p1->ps_name, p2->ps_name))) - return i; - cmp_return (p1->slant, p2->slant); - cmp_return (p1->extend, p2->extend); - if (p1->tfm_name != NULL && p2->tfm_name != NULL && - (i = strcmp (p1->tfm_name, p2->tfm_name))) - return i; - return 0; -} - -@ AVL sort |ff_entry| into |ff_tree| by |ff_name| - -@c static int comp_ff_entry (const void *pa, const void *pb, void *p) { - (void)p; - return strcmp (((const ff_entry *) pa)->ff_name, - ((const ff_entry *) pb)->ff_name); -} - -@ @c static void create_avl_trees (MP mp) { - if (mp->ps->tfm_tree == NULL) { - mp->ps->tfm_tree = avl_create (comp_fm_entry_tfm, NULL, &mp->ps->avl_xallocator); - assert (mp->ps->tfm_tree != NULL); - } - if (mp->ps->ps_tree == NULL) { - mp->ps->ps_tree = avl_create (comp_fm_entry_ps, NULL, &mp->ps->avl_xallocator); - assert (mp->ps->ps_tree != NULL); - } - if (mp->ps->ff_tree == NULL) { - mp->ps->ff_tree = avl_create (comp_ff_entry, NULL, &mp->ps->avl_xallocator); - assert (mp->ps->ff_tree != NULL); - } -} - -@ The function |avl_do_entry| is not completely symmetrical with regards -to |tfm_name| and |ps_name handling|, e. g. a duplicate |tfm_name| gives a -|goto exit|, and no |ps_name| link is tried. This is to keep it compatible -with the original version. - -@d LINK_TFM 0x01 -@d LINK_PS 0x02 -@d set_tfmlink(fm) ((fm)->links |= LINK_TFM) -@d set_pslink(fm) ((fm)->links |= LINK_PS) -@d unset_tfmlink(fm) ((fm)->links &= ~LINK_TFM) -@d unset_pslink(fm) ((fm)->links &= ~LINK_PS) -@d has_tfmlink(fm) ((fm)->links & LINK_TFM) -@d has_pslink(fm) ((fm)->links & LINK_PS) - -@c -static int avl_do_entry (MP mp, fm_entry * fp, int mode) { - fm_entry *p; - void *a; - void **aa; - char s[128]; - - /* handle |tfm_name| link */ - - if (strcmp (fp->tfm_name, nontfm)) { - p = (fm_entry *) avl_find (mp->ps->tfm_tree, fp); - if (p != NULL) { - if (mode == FM_DUPIGNORE) { - mp_snprintf(s,128,"fontmap entry for `%s' already exists, duplicates ignored", - fp->tfm_name); - mp_warn(mp,s); - goto exit; - } else { /* mode == |FM_REPLACE| / |FM_DELETE| */ - if (mp_has_font_size(mp,p->tfm_num)) { - mp_snprintf(s,128, - "fontmap entry for `%s' has been used, replace/delete not allowed", - fp->tfm_name); - mp_warn(mp,s); - goto exit; - } - a = avl_delete (mp->ps->tfm_tree, p); - assert (a != NULL); - unset_tfmlink (p); - if (!has_pslink (p)) - delete_fm_entry (p); - } - } - if (mode != FM_DELETE) { - aa = avl_probe (mp->ps->tfm_tree, fp); - assert (aa != NULL); - set_tfmlink (fp); - } - } - - /* handle |ps_name| link */ - - if (fp->ps_name != NULL) { - assert (fp->tfm_name != NULL); - p = (fm_entry *) avl_find (mp->ps->ps_tree, fp); - if (p != NULL) { - if (mode == FM_DUPIGNORE) { - mp_snprintf(s,128, - "ps_name entry for `%s' already exists, duplicates ignored", - fp->ps_name); - mp_warn(mp,s); - goto exit; - } else { /* mode == |FM_REPLACE| / |FM_DELETE| */ - if (mp_has_font_size(mp,p->tfm_num)) { - /* REPLACE/DELETE not allowed */ - mp_snprintf(s,128, - "fontmap entry for `%s' has been used, replace/delete not allowed", - p->tfm_name); - mp_warn(mp,s); - goto exit; - } - a = avl_delete (mp->ps->ps_tree, p); - assert (a != NULL); - unset_pslink (p); - if (!has_tfmlink (p)) - delete_fm_entry (p); - } - } - if (mode != FM_DELETE) { - aa = avl_probe (mp->ps->ps_tree, fp); - assert (aa != NULL); - set_pslink (fp); - } - } - exit: - if (!has_tfmlink (fp) && !has_pslink (fp)) /* e. g. after |FM_DELETE| */ - return 1; /* deallocation of |fm_entry| structure required */ - else - return 0; -} - -@ consistency check for map entry, with warn flag - -@c -static int check_fm_entry (MP mp, fm_entry * fm, boolean warn) { - int a = 0; - char s[128]; - assert (fm != NULL); - if (fm->ps_name != NULL) { - if (is_basefont (fm)) { - if (is_fontfile (fm) && !is_included (fm)) { - if (warn) { - mp_snprintf(s,128, "invalid entry for `%s': " - "font file must be included or omitted for base fonts", - fm->tfm_name); - mp_warn(mp,s); - } - a += 1; - } - } else { /* not a base font */ - /* if no font file given, drop this entry */ - /* |if (!is_fontfile (fm)) { - if (warn) { - mp_snprintf(s,128, - "invalid entry for `%s': font file missing", - fm->tfm_name); - mp_warn(mp,s); - } - a += 2; - }| - */ - } - } - if (is_truetype (fm) && is_reencoded (fm) && !is_subsetted (fm)) { - if (warn) { - mp_snprintf(s,128, - "invalid entry for `%s': only subsetted TrueType font can be reencoded", - fm->tfm_name); - mp_warn(mp,s); - } - a += 4; - } - if ((fm->slant != 0 || fm->extend != 0) && - (is_truetype (fm))) { - if (warn) { - mp_snprintf(s,128, - "invalid entry for `%s': " - "SlantFont/ExtendFont can be used only with embedded T1 fonts", - fm->tfm_name); - mp_warn(mp,s); - } - a += 8; - } - if (abs (fm->slant) > 1000) { - if (warn) { - mp_snprintf(s,128, - "invalid entry for `%s': too big value of SlantFont (%d/1000.0)", - fm->tfm_name, (int)fm->slant); - mp_warn(mp,s); - } - a += 16; - } - if (abs (fm->extend) > 2000) { - if (warn) { - mp_snprintf(s,128, - "invalid entry for `%s': too big value of ExtendFont (%d/1000.0)", - fm->tfm_name, (int)fm->extend); - mp_warn(mp,s); - } - a += 32; - } - if (fm->pid != -1 && - !(is_truetype (fm) && is_included (fm) && - is_subsetted (fm) && !is_reencoded (fm))) { - if (warn) { - mp_snprintf(s,128, - "invalid entry for `%s': " - "PidEid can be used only with subsetted non-reencoded TrueType fonts", - fm->tfm_name); - mp_warn(mp,s); - } - a += 64; - } - return a; -} - -@ returns true if s is one of the 14 std. font names; speed-trimmed. - -@c static boolean check_basefont (char *s) { - static const char *basefont_names[] = { - "Courier", /* 0:7 */ - "Courier-Bold", /* 1:12 */ - "Courier-Oblique", /* 2:15 */ - "Courier-BoldOblique", /* 3:19 */ - "Helvetica", /* 4:9 */ - "Helvetica-Bold", /* 5:14 */ - "Helvetica-Oblique", /* 6:17 */ - "Helvetica-BoldOblique", /* 7:21 */ - "Symbol", /* 8:6 */ - "Times-Roman", /* 9:11 */ - "Times-Bold", /* 10:10 */ - "Times-Italic", /* 11:12 */ - "Times-BoldItalic", /* 12:16 */ - "ZapfDingbats" /* 13:12 */ - }; - static const int Index[] = - { -1, -1, -1, -1, -1, -1, 8, 0, -1, 4, 10, 9, -1, -1, 5, 2, 12, 6, - -1, 3, -1, 7 - }; - const size_t n = strlen (s); - int k = -1; - if (n > 21) - return false; - if (n == 12) { /* three names have length 12 */ - switch (*s) { - case 'C': - k = 1; /* Courier-Bold */ - break; - case 'T': - k = 11; /* Times-Italic */ - break; - case 'Z': - k = 13; /* ZapfDingbats */ - break; - default: - return false; - } - } else - k = Index[n]; - if (k > -1 && !strcmp (basefont_names[k], s)) - return true; - return false; -} - -@ -@d is_cfg_comment(c) (c == 10 || c == '*' || c == '#' || c == ';' || c == '%') - -@c static void fm_scan_line (MP mp) { - int a, b, c, j, u = 0, v = 0; - float d; - fm_entry *fm; - char fm_line[FM_BUF_SIZE], buf[FM_BUF_SIZE]; - char *p, *q, *r, *s; - char warn_s[128]; - switch (mp->ps->mitem->type) { - case MAPFILE: - p = fm_line; - do { - c = fm_getchar (mp); - append_char_to_buf (c, p, fm_line, FM_BUF_SIZE); - } while (c != 10); - *(--p) = '\0'; - r = fm_line; - break; - case MAPLINE: - r = mp->ps->mitem->map_line; - break; - default: - assert (0); - } - if (*r == '\0' || is_cfg_comment (*r)) - return; - fm = new_fm_entry (mp); - read_field (r, q, buf); - set_field (tfm_name); - p = r; - read_field (r, q, buf); - if (*buf != '<' && *buf != '"') - set_field (ps_name); - else - r = p; /* unget the field */ - if (mp_isdigit (*r)) { /* font flags given */ - fm->flags = atoi (r); - while (mp_isdigit (*r)) - r++; - } - while (1) { /* loop through "specials", encoding, font file */ - skip (r, ' '); - switch (*r) { - case '\0': - goto DONE; - case '"': /* opening quote */ - r++; - u = v = 0; - do { - skip (r, ' '); - if (sscanf (r, "%f %n", &d, &j) > 0) { - s = r + j; /* jump behind number, eat also blanks, if any */ - if (*(s - 1) == 'E' || *(s - 1) == 'e') - s--; /* e. g. 0.5ExtendFont: \%f = 0.5E */ - if (str_prefix (s, "SlantFont")) { - d *= 1000.0; /* correct rounding also for neg. numbers */ - fm->slant = (short int) (d > 0 ? d + 0.5 : d - 0.5); - r = s + strlen ("SlantFont"); - } else if (str_prefix (s, "ExtendFont")) { - d *= 1000.0; - fm->extend = (short int) (d > 0 ? d + 0.5 : d - 0.5); - if (fm->extend == 1000) - fm->extend = 0; - r = s + strlen ("ExtendFont"); - } else { /* unknown name */ - for (r = s; - *r != ' ' && *r != '"' && *r != '\0'; - r++); /* jump over name */ - c = *r; /* remember char for temporary end of string */ - *r = '\0'; - mp_snprintf(warn_s,128, - "invalid entry for `%s': unknown name `%s' ignored", - fm->tfm_name, s); - mp_warn(mp,warn_s); - *r = c; - } - } else - for (; *r != ' ' && *r != '"' && *r != '\0'; r++); - } - while (*r == ' '); - if (*r == '"') /* closing quote */ - r++; - else { - mp_snprintf(warn_s,128, - "invalid entry for `%s': closing quote missing", - fm->tfm_name); - mp_warn(mp,warn_s); - goto bad_line; - } - break; - case 'P': /* handle cases for subfonts like 'PidEid=3,1' */ - if (sscanf (r, "PidEid=%i, %i %n", &a, &b, &c) >= 2) { - fm->pid = (short int)a; - fm->eid = (short int)b; - r += c; - break; - } /* fallthrough */ - default: /* encoding or font file specification */ - a = b = 0; - if (*r == '<') { - a = *r++; - if (*r == '<' || *r == '[') - b = *r++; - } - read_field (r, q, buf); - /* encoding, formats: '8r.enc' or '<8r.enc' or '<[8r.enc' */ - if (strlen (buf) > 4 && mp_strcasecmp (strend (buf) - 4, ".enc") == 0) { - fm->encoding = mp_add_enc (mp, buf); - u = v = 0; /* u, v used if intervening blank: "<< foo" */ - } else if (strlen (buf) > 0) { /* file name given */ - /* font file, formats: - * subsetting: '<cmr10.pfa' - * no subsetting: '<<cmr10.pfa' - * no embedding: 'cmr10.pfa' - */ - if (a == '<' || u == '<') { - set_included (fm); - if ((a == '<' && b == 0) || (a == 0 && v == 0)) - set_subsetted (fm); - /* otherwise b == '<' (or '[') => no subsetting */ - } - set_field (ff_name); - u = v = 0; - } else { - u = a; - v = b; - } - } - } - DONE: - if (fm->ps_name != NULL && check_basefont (fm->ps_name)) - set_basefont (fm); - if (is_fontfile (fm) - && mp_strcasecmp (strend (fm_fontfile (fm)) - 4, ".ttf") == 0) - set_truetype (fm); - if (check_fm_entry (mp,fm, true) != 0) - goto bad_line; - /* - Until here the map line has been completely scanned without errors; - fm points to a valid, freshly filled-out |fm_entry| structure. - Now follows the actual work of registering/deleting. - */ - if (avl_do_entry (mp, fm, mp->ps->mitem->mode) == 0) /* if success */ - return; - bad_line: - delete_fm_entry (fm); -} - -@ -@c static void fm_read_info (MP mp) { - char *n; - char s[256]; - if (mp->ps->tfm_tree == NULL) - create_avl_trees (mp); - if (mp->ps->mitem->map_line == NULL) /* nothing to do */ - return; - mp->ps->mitem->lineno = 1; - switch (mp->ps->mitem->type) { - case MAPFILE: - n = mp->ps->mitem->map_line; - mp->ps->fm_file = (mp->open_file)(mp, n, "r", mp_filetype_fontmap); - if (!mp->ps->fm_file) { - mp_snprintf(s,256,"cannot open font map file %s",n); - mp_warn(mp,s); - } else { - unsigned save_selector = mp->selector; - mp_normalize_selector(mp); - mp_print (mp, "{"); - mp_print (mp, n); - while (!fm_eof ()) { - fm_scan_line (mp); - mp->ps->mitem->lineno++; - } - fm_close (); - mp_print (mp,"}"); - mp->selector = save_selector; - mp->ps->fm_file = NULL; - } - mp_xfree(n); - break; - case MAPLINE: - fm_scan_line (mp); - break; - default: - assert (0); - } - mp->ps->mitem->map_line = NULL; /* done with this line */ - return; -} - -@ @c static void init_fm (fm_entry * fm, font_number f) { - if (fm->tfm_num == null_font ) { - fm->tfm_num = f; - fm->tfm_avail = TFM_FOUND; - } -} - -@ @<Declarations@>= -static fm_entry * mp_fm_lookup (MP mp, font_number f); - -@ @c -static fm_entry * mp_fm_lookup (MP mp, font_number f) { - char *tfm; - fm_entry *fm; - fm_entry tmp; - int e; - if (mp->ps->tfm_tree == NULL) - fm_read_info (mp); /* only to read default map file */ - tfm = mp->font_name[f]; - assert (strcmp (tfm, nontfm)); - /* Look up for full <tfmname>[+-]<expand> */ - tmp.tfm_name = tfm; - fm = (fm_entry *) avl_find (mp->ps->tfm_tree, &tmp); - if (fm != NULL) { - init_fm (fm, f); - return (fm_entry *) fm; - } - tfm = mk_base_tfm (mp, mp->font_name[f], &e); - if (tfm == NULL) /* not an expanded font, nothing to do */ - return NULL; - - tmp.tfm_name = tfm; - fm = (fm_entry *) avl_find (mp->ps->tfm_tree, &tmp); - if (fm != NULL) { /* found an entry with the base tfm name, e.g. cmr10 */ - return (fm_entry *) fm; /* font expansion uses the base font */ - } - return NULL; -} - -@ Early check whether a font file exists. Used e. g. for replacing fonts - of embedded PDF files: Without font file, the font within the embedded - PDF-file is used. Search tree |ff_tree| is used in 1st instance, as it - may be faster than the |kpse_find_file()|, and |kpse_find_file()| is called - only once per font file name + expansion parameter. This might help - keeping speed, if many PDF pages with same fonts are to be embedded. - - The |ff_tree| contains only font files, which are actually needed, - so this tree typically is much smaller than the |tfm_tree| or |ps_tree|. - -@c -static ff_entry *check_ff_exist (MP mp, fm_entry * fm) { - ff_entry *ff; - ff_entry tmp; - void **aa; - - assert (fm->ff_name != NULL); - tmp.ff_name = fm->ff_name; - ff = (ff_entry *) avl_find (mp->ps->ff_tree, &tmp); - if (ff == NULL) { /* not yet in database */ - ff = new_ff_entry (mp); - ff->ff_name = mp_xstrdup (mp,fm->ff_name); - ff->ff_path = mp_xstrdup (mp,fm->ff_name); - aa = avl_probe (mp->ps->ff_tree, ff); - assert (aa != NULL); - } - return ff; -} - -@ Process map file given by its name or map line contents. Items not -beginning with [+-=] flush default map file, if it has not yet been -read. Leading blanks and blanks immediately following [+-=] are ignored. - - -@c static void mp_process_map_item (MP mp, char *s, int type) { - char *p; - int mode; - if (*s == ' ') - s++; /* ignore leading blank */ - switch (*s) { - case '+': /* +mapfile.map, +mapline */ - mode = FM_DUPIGNORE; /* insert entry, if it is not duplicate */ - s++; - break; - case '=': /* =mapfile.map, =mapline */ - mode = FM_REPLACE; /* try to replace earlier entry */ - s++; - break; - case '-': /* -mapfile.map, -mapline */ - mode = FM_DELETE; /* try to delete entry */ - s++; - break; - default: - mode = FM_DUPIGNORE; /* like +, but also: */ - mp_xfree(mp->ps->mitem->map_line); - mp->ps->mitem->map_line = NULL; /* flush default map file name */ - } - if (*s == ' ') - s++; /* ignore blank after [+-=] */ - p = s; /* map item starts here */ - switch (type) { - case MAPFILE: /* remove blank at end */ - while (*p != '\0' && *p != ' ') - p++; - *p = '\0'; - break; - case MAPLINE: /* blank at end allowed */ - break; - default: - assert (0); - } - if (mp->ps->mitem->map_line != NULL) /* read default map file first */ - fm_read_info (mp); - if (*s != '\0') { /* only if real item to process */ - mp->ps->mitem->mode = mode; - mp->ps->mitem->type = type; - mp->ps->mitem->map_line = s; - fm_read_info (mp); - } -} - -@ @<Exported function headers@>= -void mp_map_file (MP mp, str_number t); -void mp_map_line (MP mp, str_number t); -void mp_init_map_file (MP mp, int is_troff); - -@ @c -void mp_map_file (MP mp, str_number t) { - char *s = mp_xstrdup(mp,mp_str (mp,t)); - mp_process_map_item (mp, s, MAPFILE); -} -void mp_map_line (MP mp, str_number t) { - char *s = mp_xstrdup(mp,mp_str (mp,t)); - mp_process_map_item (mp, s, MAPLINE); -} - -@ -@c void mp_init_map_file (MP mp, int is_troff) { - char *r; - mp->ps->mitem = mp_xmalloc (mp,1,sizeof(mapitem)); - mp->ps->mitem->mode = FM_DUPIGNORE; - mp->ps->mitem->type = MAPFILE; - mp->ps->mitem->map_line = NULL; - r = (mp->find_file)(mp,"mpost.map", "r", mp_filetype_fontmap); - if (r != NULL) { - mp_xfree(r); - mp->ps->mitem->map_line = mp_xstrdup (mp,"mpost.map"); - } else { - if (is_troff) { - mp->ps->mitem->map_line = mp_xstrdup (mp,"troff.map"); - } else { - mp->ps->mitem->map_line = mp_xstrdup (mp,"pdftex.map"); - } - } -} - -@ @<Dealloc variables@>= -if (mp->ps->mitem!=NULL) { - mp_xfree(mp->ps->mitem->map_line); - mp_xfree(mp->ps->mitem); -} - -@ cleaning up... - -@c -static void destroy_fm_entry_tfm (void *pa, void *pb) { - fm_entry *fm; - (void)pb; - fm = (fm_entry *) pa; - if (!has_pslink (fm)) - delete_fm_entry (fm); - else - unset_tfmlink (fm); -} -static void destroy_fm_entry_ps (void *pa, void *pb) { - fm_entry *fm; - (void)pb; - fm = (fm_entry *) pa; - if (!has_tfmlink (fm)) - delete_fm_entry (fm); - else - unset_pslink (fm); -} -static void destroy_ff_entry (void *pa, void *pb) { - ff_entry *ff; - (void)pb; - ff = (ff_entry *) pa; - delete_ff_entry (ff); -} - -@ @<Declarations@>= -static void fm_free (MP mp); - -@ @c -static void fm_free (MP mp) { - if (mp->ps->tfm_tree != NULL) - avl_destroy (mp->ps->tfm_tree, destroy_fm_entry_tfm); - if (mp->ps->ps_tree != NULL) - avl_destroy (mp->ps->ps_tree, destroy_fm_entry_ps); - if (mp->ps->ff_tree != NULL) - avl_destroy (mp->ps->ff_tree, destroy_ff_entry); -} - -@ The file |ps_tab_file| gives a table of \TeX\ font names and corresponding -PostScript names for fonts that do not have to be downloaded, i.e., fonts that -can be used when |internal[prologues]>0|. Each line consists of a \TeX\ name, -one or more spaces, a PostScript name, and possibly a space and some other junk. -This routine reads the table, updates |font_ps_name| entries starting after -|last_ps_fnum|, and sets |last_ps_fnum:=last_fnum|. - -@d ps_tab_name "psfonts.map" /* locates font name translation table */ - -@<Declarations@>= -static void mp_read_psname_table (MP mp) ; - -@ @c -static void mp_read_psname_table (MP mp) { - font_number k; - if (mp->ps->mitem == NULL) { - mp->ps->mitem = mp_xmalloc (mp,1,sizeof(mapitem)); - mp->ps->mitem->mode = FM_DUPIGNORE; - mp->ps->mitem->type = MAPFILE; - mp->ps->mitem->map_line = NULL; - } - mp->ps->mitem->map_line = mp_xstrdup (mp,ps_tab_name); - fm_read_info (mp); - for (k=mp->last_ps_fnum+1;k<=mp->last_fnum;k++) { - if (mp_has_fm_entry(mp, k, NULL)) { - mp->font_ps_name[k] = mp_fm_font_name(mp,k); - } - } - mp->last_ps_fnum=mp->last_fnum; -} - - -@ The traditional function is a lot shorter now. - - - -@* \[44c] Helper functions for Type1 fonts. - -@<Types...@>= -typedef char char_entry; -typedef unsigned char Byte; -typedef Byte Bytef; - -@ @<Glob...@>= -char_entry *char_ptr, *char_array; -size_t char_limit; -char *job_id_string; - -@ @<Set initial...@>= -mp->ps->char_array = NULL; -mp->ps->job_id_string = NULL; - -@ -@d SMALL_ARRAY_SIZE 256 -@d Z_NULL 0 - -@c -void mp_set_job_id (MP mp) { - char *name_string, *format_string, *s; - size_t slen; - if (mp->ps->job_id_string != NULL) - return; - if ( mp->job_name==NULL ) - mp->job_name = mp_xstrdup(mp,"mpout"); - name_string = mp_xstrdup (mp,mp->job_name); - format_string = mp_xstrdup (mp,mp->mem_ident); - slen = SMALL_BUF_SIZE + - strlen (name_string) + - strlen (format_string); - s = mp_xmalloc (mp,slen, sizeof (char)); - @= /*@@-bufferoverflowhigh@@*/ @> - sprintf (s,"%.4u/%.2u/%.2u %.2u:%.2u %s %s", - ((unsigned)mp->internal[mp_year]>>16), - ((unsigned)mp->internal[mp_month]>>16), - ((unsigned)mp->internal[mp_day]>>16), - ((unsigned)mp->internal[mp_time]>>16) / 60, - ((unsigned)mp->internal[mp_time]>>16) % 60, - name_string, format_string); - @= /*@@=bufferoverflowhigh@@*/ @> - mp->ps->job_id_string = mp_xstrdup (mp,s); - mp_xfree (s); - mp_xfree (name_string); - mp_xfree (format_string); -} -static void fnstr_append (MP mp, const char *s) { - size_t l = strlen (s) + 1; - alloc_array (char, l, SMALL_ARRAY_SIZE); - strcat (mp->ps->char_ptr, s); - mp->ps->char_ptr = strend (mp->ps->char_ptr); -} - -@ @<Exported function headers@>= -void mp_set_job_id (MP mp) ; - -@ @<Dealloc variables@>= -mp_xfree(mp->ps->job_id_string); - -@ this is not really a true crc32, but it should be just enough to keep - subsets prefixes somewhat disjunct - -@c -static unsigned long crc32 (unsigned long oldcrc, const Byte *buf, size_t len) { - unsigned long ret = 0; - size_t i; - if (oldcrc==0) - ret = (unsigned long)((23<<24)+(45<<16)+(67<<8)+89); - else - for (i=0;i<len;i++) - ret = (ret<<2)+buf[i]; - return ret; -} -static boolean mp_char_marked (MP mp,font_number f, eight_bits c) { - integer b; /* |char_base[f]| */ - b=mp->char_base[f]; - if ( (c>=mp->font_bc[f])&&(c<=mp->font_ec[f])&&(mp->font_info[b+c].qqqq.b3!=0) ) - return true; - else - return false; -} - -static void make_subset_tag (MP mp, fm_entry * fm_cur, char **glyph_names, font_number tex_font) -{ - char tag[7]; - unsigned long crc; - int i; - size_t l ; - if (mp->ps->job_id_string ==NULL) - mp_fatal_error(mp, "no job id!"); - l = strlen (mp->ps->job_id_string) + 1; - - alloc_array (char, l, SMALL_ARRAY_SIZE); - strcpy (mp->ps->char_array, mp->ps->job_id_string); - mp->ps->char_ptr = strend (mp->ps->char_array); - if (fm_cur->tfm_name != NULL) { - fnstr_append (mp," TFM name: "); - fnstr_append (mp,fm_cur->tfm_name); - } - fnstr_append (mp," PS name: "); - if (fm_cur->ps_name != NULL) - fnstr_append (mp,fm_cur->ps_name); - fnstr_append (mp," Encoding: "); - if (fm_cur->encoding != NULL && (fm_cur->encoding)->file_name != NULL) - fnstr_append (mp,(fm_cur->encoding)->file_name); - else - fnstr_append (mp,"built-in"); - fnstr_append (mp," CharSet: "); - for (i = 0; i < 256; i++) - if (mp_char_marked (mp,tex_font, (eight_bits)i) && glyph_names[i] != notdef) { - if (glyph_names[i]!=NULL) { - fnstr_append (mp,"/"); - fnstr_append (mp,glyph_names[i]); - } - } - if (fm_cur->charset != NULL) { - fnstr_append (mp," Extra CharSet: "); - fnstr_append (mp, fm_cur->charset); - } - crc = crc32 (0L, Z_NULL, 0); - crc = crc32 (crc, (Bytef *) mp->ps->char_array, strlen (mp->ps->char_array)); - /* we need to fit a 32-bit number into a string of 6 uppercase chars long; - * there are 26 uppercase chars ==> each char represents a number in range - * |0..25|. The maximal number that can be represented by the tag is - * $26^6 - 1$, which is a number between $2^28$ and $2^29$. Thus the bits |29..31| - * of the CRC must be dropped out. - */ - for (i = 0; i < 6; i++) { - tag[i] = 'A' + crc % 26; - crc /= 26; - } - tag[6] = 0; - fm_cur->subset_tag = mp_xstrdup (mp,tag); -} - - - -@ -@d external_enc() (fm_cur->encoding)->glyph_names -@d is_used_char(c) mp_char_marked (mp, tex_font, (eight_bits)c) -@d end_last_eexec_line() - mp->ps->hexline_length = HEXLINE_WIDTH; - end_hexline(mp); - mp->ps->t1_eexec_encrypt = false -@d t1_log(s) mp_print(mp,(char *)s) -@d t1_putchar(c) wps_chr(c) -@d embed_all_glyphs(tex_font) false -@d t1_char(c) c -@d extra_charset() mp->ps->dvips_extra_charset -@d update_subset_tag() -@d fixedcontent true - -@<Glob...@>= -#define PRINTF_BUF_SIZE 1024 -char *dvips_extra_charset; -char *cur_enc_name; -unsigned char *grid; -char *ext_glyph_names[256]; -char print_buf[PRINTF_BUF_SIZE]; -int t1_byte_waiting; - -@ @<Set initial ...@>= -mp->ps->dvips_extra_charset=NULL; -mp->ps->t1_byte_waiting=0; - -@ -@d t1_ungetchar(A) mp->ps->t1_byte_waiting=(int)(A) -@d t1_eof() (mp->eof_file)(mp,mp->ps->t1_file) -@d t1_close() (mp->close_file)(mp,mp->ps->t1_file) -@d valid_code(c) (c >= 0 && c < 256) - -@c -static int t1_getchar (MP mp) { - size_t len = 1; - unsigned char abyte=0; - void *byte_ptr = &abyte; - if (mp->ps->t1_byte_waiting) { - abyte = mp->ps->t1_byte_waiting; - mp->ps->t1_byte_waiting = 0; - } else { - (mp->read_binary_file)(mp,mp->ps->t1_file,&byte_ptr,&len); - } - return (int)abyte; -} - -@ @<Static variables in the outer block@>= -static const char *standard_glyph_names[256] = - { notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, - notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, - notdef, notdef, notdef, notdef, notdef, notdef, - notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, - "space", "exclam", "quotedbl", "numbersign", - "dollar", "percent", "ampersand", "quoteright", "parenleft", - "parenright", "asterisk", "plus", "comma", "hyphen", "period", - "slash", "zero", "one", "two", "three", "four", "five", "six", "seven", - "eight", "nine", "colon", "semicolon", "less", - "equal", "greater", "question", "at", "A", "B", "C", "D", "E", "F", - "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", - "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "bracketleft", - "backslash", "bracketright", "asciicircum", "underscore", - "quoteleft", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", - "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", - "w", "x", "y", "z", "braceleft", "bar", "braceright", "asciitilde", - notdef, notdef, notdef, notdef, notdef, notdef, notdef, - notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, - notdef, notdef, notdef, notdef, notdef, notdef, - notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, - notdef, notdef, notdef, "exclamdown", "cent", - "sterling", "fraction", "yen", "florin", "section", "currency", - "quotesingle", "quotedblleft", "guillemotleft", - "guilsinglleft", "guilsinglright", "fi", "fl", notdef, "endash", - "dagger", "daggerdbl", "periodcentered", notdef, - "paragraph", "bullet", "quotesinglbase", "quotedblbase", - "quotedblright", "guillemotright", "ellipsis", "perthousand", - notdef, "questiondown", notdef, "grave", "acute", "circumflex", - "tilde", "macron", "breve", "dotaccent", "dieresis", notdef, - "ring", "cedilla", notdef, "hungarumlaut", "ogonek", "caron", "emdash", - notdef, notdef, notdef, notdef, notdef, notdef, - notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, - notdef, "AE", notdef, "ordfeminine", notdef, notdef, - notdef, notdef, "Lslash", "Oslash", "OE", "ordmasculine", notdef, - notdef, notdef, notdef, notdef, "ae", notdef, notdef, - notdef, "dotlessi", notdef, notdef, "lslash", "oslash", "oe", - "germandbls", notdef, notdef, notdef, notdef }; -static const char charstringname[] = "/CharStrings"; - -@ @<Glob...@>= -char **t1_glyph_names; -char *t1_builtin_glyph_names[256]; -char charsetstr[0x4000]; -boolean read_encoding_only; -int t1_encoding; - -@ @c -#define T1_BUF_SIZE 0x10 - -#define CS_HSTEM 1 -#define CS_VSTEM 3 -#define CS_VMOVETO 4 -#define CS_RLINETO 5 -#define CS_HLINETO 6 -#define CS_VLINETO 7 -#define CS_RRCURVETO 8 -#define CS_CLOSEPATH 9 -#define CS_CALLSUBR 10 -#define CS_RETURN 11 -#define CS_ESCAPE 12 -#define CS_HSBW 13 -#define CS_ENDCHAR 14 -#define CS_RMOVETO 21 -#define CS_HMOVETO 22 -#define CS_VHCURVETO 30 -#define CS_HVCURVETO 31 -#define CS_1BYTE_MAX (CS_HVCURVETO + 1) - -#define CS_DOTSECTION CS_1BYTE_MAX + 0 -#define CS_VSTEM3 CS_1BYTE_MAX + 1 -#define CS_HSTEM3 CS_1BYTE_MAX + 2 -#define CS_SEAC CS_1BYTE_MAX + 6 -#define CS_SBW CS_1BYTE_MAX + 7 -#define CS_DIV CS_1BYTE_MAX + 12 -#define CS_CALLOTHERSUBR CS_1BYTE_MAX + 16 -#define CS_POP CS_1BYTE_MAX + 17 -#define CS_SETCURRENTPOINT CS_1BYTE_MAX + 33 -#define CS_2BYTE_MAX (CS_SETCURRENTPOINT + 1) -#define CS_MAX CS_2BYTE_MAX - -@ @<Types...@>= -typedef unsigned char byte; -typedef struct { - byte nargs; /* number of arguments */ - boolean bottom; /* take arguments from bottom of stack? */ - boolean clear; /* clear stack? */ - boolean valid; -} cc_entry; /* CharString Command */ -typedef struct { - char *glyph_name; /* glyph name (or notdef for Subrs entry) */ - byte *data; - unsigned short len; /* length of the whole string */ - unsigned short cslen; /* length of the encoded part of the string */ - boolean is_used; - boolean valid; -} cs_entry; - -@ -@d t1_c1 52845 -@d t1_c2 22719 - -@<Glob...@>= -unsigned short t1_dr, t1_er; -unsigned short t1_cslen; -short t1_lenIV; - -@ @<Types...@>= -typedef char t1_line_entry; -typedef char t1_buf_entry; - -@ @<Glob...@>= -t1_line_entry *t1_line_ptr, *t1_line_array; -size_t t1_line_limit; -t1_buf_entry *t1_buf_ptr, *t1_buf_array; -size_t t1_buf_limit; -int cs_start; -cs_entry *cs_tab, *cs_ptr, *cs_notdef; -char *cs_dict_start, *cs_dict_end; -int cs_count, cs_size, cs_size_pos; -cs_entry *subr_tab; -char *subr_array_start, *subr_array_end; -int subr_max, subr_size, subr_size_pos; - -@ @<Set initial...@>= -mp->ps->t1_line_array = NULL; -mp->ps->t1_buf_array = NULL; - -@ - This list contains the begin/end tokens commonly used in the - /Subrs array of a Type 1 font. - -@<Static variables in the outer block@>= -static const char *cs_token_pairs_list[][2] = { - {" RD", "NP"}, - {" -|", "|"}, - {" RD", "noaccess put"}, - {" -|", "noaccess put"}, - {NULL, NULL} -}; - -@ @<Glob...@>= -const char **cs_token_pair; -boolean t1_pfa, t1_cs, t1_scan, t1_eexec_encrypt, t1_synthetic; -int t1_in_eexec; /* 0 before eexec-encrypted, 1 during, 2 after */ -int t1_block_length; -int last_hexbyte; -void *t1_file; -int hexline_length; - -@ -@d HEXLINE_WIDTH 64 - -@<Set initial ...@>= -mp->ps->hexline_length = 0; - -@ -@d t1_prefix(s) str_prefix(mp->ps->t1_line_array, s) -@d t1_buf_prefix(s) str_prefix(mp->ps->t1_buf_array, s) -@d t1_suffix(s) str_suffix(mp->ps->t1_line_array, mp->ps->t1_line_ptr, s) -@d t1_buf_suffix(s) str_suffix(mp->ps->t1_buf_array, mp->ps->t1_buf_ptr, s) -@d t1_charstrings() strstr(mp->ps->t1_line_array, charstringname) -@d t1_subrs() t1_prefix("/Subrs") -@d t1_end_eexec() t1_suffix("mark currentfile closefile") -@d t1_cleartomark() t1_prefix("cleartomark") - -@c -static void end_hexline (MP mp) { - if (mp->ps->hexline_length >= HEXLINE_WIDTH) { - wps_cr; - mp->ps->hexline_length = 0; - } -} -static void t1_check_pfa (MP mp) { - const int c = t1_getchar (mp); - mp->ps->t1_pfa = (c != 128) ? true : false; - t1_ungetchar (c); -} -static int t1_getbyte (MP mp) -{ - int c = t1_getchar (mp); - if (mp->ps->t1_pfa) - return c; - if (mp->ps->t1_block_length == 0) { - if (c != 128) - mp_fatal_error (mp, "invalid marker"); - c = t1_getchar (mp); - if (c == 3) { - while (!t1_eof ()) - (void)t1_getchar (mp); - return EOF; - } - mp->ps->t1_block_length = t1_getchar (mp) & 0xff; - mp->ps->t1_block_length |= (unsigned)(t1_getchar (mp) & 0xff) << 8; - mp->ps->t1_block_length |= (unsigned)(t1_getchar (mp) & 0xff) << 16; - mp->ps->t1_block_length |= (unsigned)(t1_getchar (mp) & 0xff) << 24; - c = t1_getchar (mp); - } - mp->ps->t1_block_length--; - return c; -} -static int hexval (int c) { - if (c >= 'A' && c <= 'F') - return c - 'A' + 10; - else if (c >= 'a' && c <= 'f') - return c - 'a' + 10; - else if (c >= '0' && c <= '9') - return c - '0'; - else - return -1; -} -static byte edecrypt (MP mp, byte cipher) { - byte plain; - if (mp->ps->t1_pfa) { - while (cipher == 10 || cipher == 13) - cipher = (byte)t1_getbyte (mp); - mp->ps->last_hexbyte = cipher = (byte)(((byte)hexval (cipher) << 4) + - hexval (t1_getbyte (mp))); - } - plain = (cipher ^ (mp->ps->t1_dr >> 8)); - mp->ps->t1_dr = (cipher + mp->ps->t1_dr) * t1_c1 + t1_c2; - return plain; -} -static byte cdecrypt (byte cipher, unsigned short *cr) -{ - const byte plain = (cipher ^ (*cr >> 8)); - *cr = (cipher + *cr) * t1_c1 + t1_c2; - return plain; -} -static byte eencrypt (MP mp, byte plain) -{ - const byte cipher = (plain ^ (mp->ps->t1_er >> 8)); - mp->ps->t1_er = (cipher + mp->ps->t1_er) * t1_c1 + t1_c2; - return cipher; -} - -static byte cencrypt (byte plain, unsigned short *cr) -{ - const byte cipher = (plain ^ (*cr >> 8)); - *cr = (cipher + *cr) * t1_c1 + t1_c2; - return cipher; -} - -static char *eol (char *s) { - char *p = strend (s); - if (p!=NULL && p - s > 1 && p[-1] != 10) { - *p++ = 10; - *p = 0; - } - return p; -} -static float t1_scan_num (MP mp, char *p, char **r) -{ - float f; - char s[128]; - skip (p, ' '); - if (sscanf (p, "%g", &f) != 1) { - remove_eol (p, mp->ps->t1_line_array); - mp_snprintf(s,128, "a number expected: `%s'", mp->ps->t1_line_array); - mp_fatal_error(mp,s); - } - if (r != NULL) { - for (; mp_isdigit (*p) || *p == '.' || - *p == 'e' || *p == 'E' || *p == '+' || *p == '-'; p++); - *r = p; - } - return f; -} - -static boolean str_suffix (const char *begin_buf, const char *end_buf, - const char *s) -{ - const char *s1 = end_buf - 1, *s2 = strend (s) - 1; - if (*s1 == 10) - s1--; - while (s1 >= begin_buf && s2 >= s) { - if (*s1-- != *s2--) - return false; - } - return s2 < s; -} - -@ - -@d alloc_array(T, n, s) do { - if (mp->ps->T##_array == NULL) { - mp->ps->T##_limit = (s); - if ((size_t)(n) > mp->ps->T##_limit) - mp->ps->T##_limit = (size_t)(n); - mp->ps->T##_array = mp_xmalloc (mp,mp->ps->T##_limit,sizeof(T##_entry)); - mp->ps->T##_ptr = mp->ps->T##_array; - } - else if ((size_t)(mp->ps->T##_ptr - mp->ps->T##_array + (n)) > mp->ps->T##_limit) { - size_t last_ptr_index; - last_ptr_index = (size_t)(mp->ps->T##_ptr - mp->ps->T##_array); - mp->ps->T##_limit *= 2; - if ((size_t)(mp->ps->T##_ptr - mp->ps->T##_array + (n)) > mp->ps->T##_limit) - mp->ps->T##_limit = (size_t)(mp->ps->T##_ptr - mp->ps->T##_array + (n)); - mp->ps->T##_array = mp_xrealloc(mp,mp->ps->T##_array,mp->ps->T##_limit, sizeof(T##_entry)); - mp->ps->T##_ptr = mp->ps->T##_array + last_ptr_index; - } -} while (0) - -@d out_eexec_char(A) t1_outhex(mp,(A)) - -@c -static void t1_outhex (MP mp, byte b) -{ - static const char *hexdigits = "0123456789ABCDEF"; - t1_putchar (hexdigits[b / 16]); - t1_putchar (hexdigits[b % 16]); - mp->ps->hexline_length += 2; - end_hexline (mp); -} -static void t1_getline (MP mp) { - int c, l, eexec_scan; - char *p; - static const char eexec_str[] = "currentfile eexec"; - static int eexec_len = 17; /* |strlen(eexec_str)| */ - RESTART: - if (t1_eof ()) - mp_fatal_error (mp,"unexpected end of file"); - mp->ps->t1_line_ptr = mp->ps->t1_line_array; - alloc_array (t1_line, 1, T1_BUF_SIZE); - mp->ps->t1_cslen = 0; - eexec_scan = 0; - c = t1_getbyte (mp); - if (c == EOF) - goto EXIT; - while (!t1_eof ()) { - if (mp->ps->t1_in_eexec == 1) - c = edecrypt (mp,(byte)c); - alloc_array (t1_line, 1, T1_BUF_SIZE); - append_char_to_buf (c, mp->ps->t1_line_ptr, mp->ps->t1_line_array, mp->ps->t1_line_limit); - if (mp->ps->t1_in_eexec == 0 && eexec_scan >= 0 && eexec_scan < eexec_len) { - if (mp->ps->t1_line_array[eexec_scan] == eexec_str[eexec_scan]) - eexec_scan++; - else - eexec_scan = -1; - } - if (c == 10 || (mp->ps->t1_pfa && eexec_scan == eexec_len && c == 32)) - break; - if (mp->ps->t1_cs && mp->ps->t1_cslen == 0 && - (mp->ps->t1_line_ptr - mp->ps->t1_line_array > 4) && - (t1_suffix (" RD ") || t1_suffix (" -| "))) { - p = mp->ps->t1_line_ptr - 5; - while (*p != ' ') - p--; - l = (int)t1_scan_num (mp, p + 1, 0); - mp->ps->t1_cslen = (unsigned short)l; - mp->ps->cs_start = mp->ps->t1_line_ptr - mp->ps->t1_line_array; - /* |mp->ps->cs_start| is an index now */ - alloc_array (t1_line, l, T1_BUF_SIZE); - while (l-- > 0) { - *mp->ps->t1_line_ptr = (t1_line_entry)edecrypt (mp,(byte)t1_getbyte (mp)); - mp->ps->t1_line_ptr++; - } - } - c = t1_getbyte (mp); - } - alloc_array (t1_line, 2, T1_BUF_SIZE); /* |append_eol| can append 2 chars */ - append_eol (mp->ps->t1_line_ptr, mp->ps->t1_line_array, mp->ps->t1_line_limit); - if (mp->ps->t1_line_ptr - mp->ps->t1_line_array < 2) - goto RESTART; - if (eexec_scan == eexec_len) - mp->ps->t1_in_eexec = 1; - EXIT: - /* ensure that |mp->ps->t1_buf_array| has as much room as |t1_line_array| */ - mp->ps->t1_buf_ptr = mp->ps->t1_buf_array; - alloc_array (t1_buf, mp->ps->t1_line_limit, mp->ps->t1_line_limit); -} - -static void t1_putline (MP mp) -{ - char *p = mp->ps->t1_line_array; - if (mp->ps->t1_line_ptr - mp->ps->t1_line_array <= 1) - return; - if (mp->ps->t1_eexec_encrypt) { - while (p < mp->ps->t1_line_ptr) - out_eexec_char (eencrypt (mp,(byte)*p++)); - } else { - while (p < mp->ps->t1_line_ptr) - t1_putchar (*p++); - } -} - -static void t1_puts (MP mp, const char *s) -{ - if (s != mp->ps->t1_line_array) - strcpy (mp->ps->t1_line_array, s); - mp->ps->t1_line_ptr = strend (mp->ps->t1_line_array); - t1_putline (mp); -} - -static void t1_init_params (MP mp, const char *open_name_prefix, - char *cur_file_name) { - if ((open_name_prefix != NULL) && strlen(open_name_prefix)) { - t1_log (open_name_prefix); - t1_log (cur_file_name); - } - mp->ps->t1_lenIV = 4; - mp->ps->t1_dr = 55665; - mp->ps->t1_er = 55665; - mp->ps->t1_in_eexec = 0; - mp->ps->t1_cs = false; - mp->ps->t1_scan = true; - mp->ps->t1_synthetic = false; - mp->ps->t1_eexec_encrypt = false; - mp->ps->t1_block_length = 0; - t1_check_pfa (mp); -} -static void t1_close_font_file (MP mp, const char *close_name_suffix) { - if ((close_name_suffix != NULL) && strlen(close_name_suffix)) { - t1_log (close_name_suffix); - } - t1_close (); -} - -static void t1_check_block_len (MP mp, boolean decrypt) { - int l, c; - char s[128]; - if (mp->ps->t1_block_length == 0) - return; - c = t1_getbyte (mp); - if (decrypt) - c = edecrypt (mp,(byte)c); - l = mp->ps->t1_block_length; - if (!(l == 0 && (c == 10 || c == 13))) { - mp_snprintf(s,128,"%i bytes more than expected were ignored", l+ 1); - mp_warn(mp,s); - while (l-- > 0) - (void)t1_getbyte (mp); - } -} -static void t1_start_eexec (MP mp, fm_entry *fm_cur) { - int i; - if (!mp->ps->t1_pfa) - t1_check_block_len (mp, false); - for (mp->ps->t1_line_ptr = mp->ps->t1_line_array, i = 0; i < 4; i++) { - (void)edecrypt (mp, (byte)t1_getbyte (mp)); - *mp->ps->t1_line_ptr++ = 0; - } - mp->ps->t1_eexec_encrypt = true; - if (!mp->ps->read_encoding_only) - if (is_included (fm_cur)) - t1_putline (mp); /* to put the first four bytes */ -} -static void t1_stop_eexec (MP mp) { - int c; - end_last_eexec_line (); - if (!mp->ps->t1_pfa) - t1_check_block_len (mp,true); - else { - c = edecrypt (mp, (byte)t1_getbyte (mp)); - if (!(c == 10 || c == 13)) { - if (mp->ps->last_hexbyte == 0) - t1_puts (mp,"00"); - else - mp_warn (mp,"unexpected data after eexec"); - } - } - mp->ps->t1_cs = false; - mp->ps->t1_in_eexec = 2; -} -static void t1_modify_fm (MP mp) { - mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array); -} - -static void t1_modify_italic (MP mp) { - mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array); -} - -@ @<Types...@>= -typedef struct { - const char *pdfname; - const char *t1name; - float value; - boolean valid; -} key_entry; - -@ -@d FONT_KEYS_NUM 11 - -@<Declarations@>= -static key_entry font_keys[FONT_KEYS_NUM] = { - {"Ascent", "Ascender", 0, false}, - {"CapHeight", "CapHeight", 0, false}, - {"Descent", "Descender", 0, false}, - {"FontName", "FontName", 0, false}, - {"ItalicAngle", "ItalicAngle", 0, false}, - {"StemV", "StdVW", 0, false}, - {"XHeight", "XHeight", 0, false}, - {"FontBBox", "FontBBox", 0, false}, - {"", "", 0, false}, - {"", "", 0, false}, - {"", "", 0, false} -}; - - -@ -@d ASCENT_CODE 0 -@d CAPHEIGHT_CODE 1 -@d DESCENT_CODE 2 -@d FONTNAME_CODE 3 -@d ITALIC_ANGLE_CODE 4 -@d STEMV_CODE 5 -@d XHEIGHT_CODE 6 -@d FONTBBOX1_CODE 7 -@d FONTBBOX2_CODE 8 -@d FONTBBOX3_CODE 9 -@d FONTBBOX4_CODE 10 -@d MAX_KEY_CODE (FONTBBOX1_CODE + 1) - -@c -static void t1_scan_keys (MP mp, font_number tex_font,fm_entry *fm_cur) { - int i, k; - char *p, *r; - key_entry *key; - if (fm_extend (fm_cur) != 0 || fm_slant (fm_cur) != 0) { - if (t1_prefix ("/FontMatrix")) { - t1_modify_fm (mp); - return; - } - if (t1_prefix ("/ItalicAngle")) { - t1_modify_italic (mp); - return; - } - } - if (t1_prefix ("/FontType")) { - p = mp->ps->t1_line_array + strlen ("FontType") + 1; - if ((i = (int)t1_scan_num (mp,p, 0)) != 1) { - char s[128]; - mp_snprintf(s,125,"Type%d fonts unsupported by metapost", i); - mp_fatal_error(mp,s); - } - return; - } - for (key = font_keys; key - font_keys < MAX_KEY_CODE; key++) - if (str_prefix (mp->ps->t1_line_array + 1, key->t1name)) - break; - if (key - font_keys == MAX_KEY_CODE) - return; - key->valid = true; - p = mp->ps->t1_line_array + strlen (key->t1name) + 1; - skip (p, ' '); - if ((k = key - font_keys) == FONTNAME_CODE) { - if (*p != '/') { - char s[128]; - remove_eol (p, mp->ps->t1_line_array); - mp_snprintf(s,128,"a name expected: `%s'", mp->ps->t1_line_array); - mp_fatal_error(mp,s); - } - r = ++p; /* skip the slash */ - if (is_included (fm_cur)) { - /* save the fontname */ - strncpy (mp->ps->fontname_buf, p, FONTNAME_BUF_SIZE); - for (i=0; mp->ps->fontname_buf[i] != 10; i++); - mp->ps->fontname_buf[i]=0; - - if(is_subsetted (fm_cur)) { - if (fm_cur->encoding!=NULL && fm_cur->encoding->glyph_names!=NULL) - make_subset_tag (mp,fm_cur, fm_cur->encoding->glyph_names, tex_font); - else - make_subset_tag (mp,fm_cur, mp->ps->t1_builtin_glyph_names, tex_font); - - alloc_array (t1_line, (r-mp->ps->t1_line_array+6+1+strlen(mp->ps->fontname_buf)+1), - T1_BUF_SIZE); - strncpy (r, fm_cur->subset_tag , 6); - *(r+6) = '-'; - strncpy (r+7, mp->ps->fontname_buf, strlen(mp->ps->fontname_buf)+1); - mp->ps->t1_line_ptr = eol (r); - } else { - /* |for (q = p; *q != ' ' && *q != 10; *q++);|*/ - /*|*q = 0;|*/ - mp->ps->t1_line_ptr = eol (r); - } - } - return; - } - if ((k == STEMV_CODE || k == FONTBBOX1_CODE) - && (*p == '[' || *p == '{')) - p++; - if (k == FONTBBOX1_CODE) { - for (i = 0; i < 4; i++) { - key[i].value = t1_scan_num (mp, p, &r); - p = r; - } - return; - } - key->value = t1_scan_num (mp, p, 0); -} -static void t1_scan_param (MP mp, font_number tex_font,fm_entry *fm_cur) -{ - static const char *lenIV = "/lenIV"; - if (!mp->ps->t1_scan || *mp->ps->t1_line_array != '/') - return; - if (t1_prefix (lenIV)) { - mp->ps->t1_lenIV = (short int)t1_scan_num (mp,mp->ps->t1_line_array + strlen (lenIV), 0); - return; - } - t1_scan_keys (mp, tex_font,fm_cur); -} -static void copy_glyph_names (MP mp, char **glyph_names, int a, int b) { - if (glyph_names[b] != notdef) { - mp_xfree (glyph_names[b]); - glyph_names[b] = (char *) notdef; - } - if (glyph_names[a] != notdef) { - glyph_names[b] = mp_xstrdup (mp,glyph_names[a]); - } -} -static void t1_builtin_enc (MP mp) { - int i, a, b, c, counter = 0; - char *r, *p; - /* - * At this moment "/Encoding" is the prefix of |mp->ps->t1_line_array| - */ - if (t1_suffix ("def")) { /* predefined encoding */ - (void)sscanf (mp->ps->t1_line_array + strlen ("/Encoding"), "%256s", mp->ps->t1_buf_array); - if (strcmp (mp->ps->t1_buf_array, "StandardEncoding") == 0) { - for (i = 0; i < 256; i++) - if (standard_glyph_names[i] == notdef) - mp->ps->t1_builtin_glyph_names[i] = (char *) notdef; - else - mp->ps->t1_builtin_glyph_names[i] = - mp_xstrdup (mp,standard_glyph_names[i]); - mp->ps->t1_encoding = ENC_STANDARD; - } else { - char s[128]; - mp_snprintf(s,128, "cannot subset font (unknown predefined encoding `%s')", - mp->ps->t1_buf_array); - mp_fatal_error(mp,s); - } - return; - } else - mp->ps->t1_encoding = ENC_BUILTIN; - /* - * At this moment "/Encoding" is the prefix of |mp->ps->t1_line_array|, and the encoding is - * not a predefined encoding - * - * We have two possible forms of Encoding vector. The first case is - * - * /Encoding [/a /b /c...] readonly def - * - * and the second case can look like - * - * /Encoding 256 array 0 1 255 {1 index exch /.notdef put} for - * dup 0 /x put - * dup 1 /y put - * ... - * readonly def - */ - for (i = 0; i < 256; i++) - mp->ps->t1_builtin_glyph_names[i] = (char *) notdef; - if (t1_prefix ("/Encoding [") || t1_prefix ("/Encoding[")) { /* the first case */ - r = strchr (mp->ps->t1_line_array, '[') + 1; - skip (r, ' '); - for (;;) { - while (*r == '/') { - for (p = mp->ps->t1_buf_array, r++; - *r != 32 && *r != 10 && *r != ']' && *r != '/'; - *p++ = *r++); - *p = 0; - skip (r, ' '); - if (counter > 255) { - mp_fatal_error - (mp, "encoding vector contains more than 256 names"); - } - if (strcmp (mp->ps->t1_buf_array, notdef) != 0) - mp->ps->t1_builtin_glyph_names[counter] = mp_xstrdup (mp,mp->ps->t1_buf_array); - counter++; - } - if (*r != 10 && *r != '%') { - if (str_prefix (r, "] def") - || str_prefix (r, "] readonly def")) - break; - else { - char s[128]; - remove_eol (r, mp->ps->t1_line_array); - mp_snprintf(s,128,"a name or `] def' or `] readonly def' expected: `%s'", - mp->ps->t1_line_array); - mp_fatal_error(mp,s); - } - } - t1_getline (mp); - r = mp->ps->t1_line_array; - } - } else { /* the second case */ - p = strchr (mp->ps->t1_line_array, 10); - for (;p!=NULL;) { - if (*p == 10) { - t1_getline (mp); - p = mp->ps->t1_line_array; - } - /* - check for `dup <index> <glyph> put' - */ - if (sscanf (p, "dup %i%256s put", &i, mp->ps->t1_buf_array) == 2 && - *mp->ps->t1_buf_array == '/' && valid_code (i)) { - if (strcmp (mp->ps->t1_buf_array + 1, notdef) != 0) - mp->ps->t1_builtin_glyph_names[i] = - mp_xstrdup (mp,mp->ps->t1_buf_array + 1); - p = strstr (p, " put") + strlen (" put"); - skip (p, ' '); - } - /* - check for `dup dup <to> exch <from> get put' - */ - else if (sscanf (p, "dup dup %i exch %i get put", &b, &a) == 2 - && valid_code (a) && valid_code (b)) { - copy_glyph_names (mp,mp->ps->t1_builtin_glyph_names, a, b); - p = strstr (p, " get put") + strlen (" get put"); - skip (p, ' '); - } - /* - check for `dup dup <from> <size> getinterval <to> exch putinterval' - */ - else if (sscanf - (p, "dup dup %i %i getinterval %i exch putinterval", - &a, &c, &b) == 3 && valid_code (a) && valid_code (b) - && valid_code (c)) { - for (i = 0; i < c; i++) - copy_glyph_names (mp,mp->ps->t1_builtin_glyph_names, a + i, b + i); - p = strstr (p, " putinterval") + strlen (" putinterval"); - skip (p, ' '); - } - /* - check for `def' or `readonly def' - */ - else if ((p == mp->ps->t1_line_array || (p > mp->ps->t1_line_array && p[-1] == ' ')) - && strcmp (p, "def\n") == 0) - return; - /* - skip an unrecognizable word - */ - else { - while (*p != ' ' && *p != 10) - p++; - skip (p, ' '); - } - } - } -} - -static void t1_check_end (MP mp) { - if (t1_eof ()) - return; - t1_getline (mp); - if (t1_prefix ("{restore}")) - t1_putline (mp); -} - -@ @<Types...@>= -typedef struct { - char *ff_name; /* base name of font file */ - char *ff_path; /* full path to font file */ -} ff_entry; - -@ @c -static boolean t1_open_fontfile (MP mp, fm_entry *fm_cur,const char *open_name_prefix) { - ff_entry *ff; - ff = check_ff_exist (mp, fm_cur); - mp->ps->t1_file = NULL; - if (ff->ff_path != NULL) { - mp->ps->t1_file = (mp->open_file)(mp,ff->ff_path, "r", mp_filetype_font); - } - if (mp->ps->t1_file == NULL) { - mp_warn (mp, "cannot open Type 1 font file for reading"); - return false; - } - t1_init_params (mp,open_name_prefix,fm_cur->ff_name); - mp->ps->fontfile_found = true; - return true; -} - -static void t1_scan_only (MP mp, font_number tex_font, fm_entry *fm_cur) { - do { - t1_getline (mp); - t1_scan_param (mp,tex_font, fm_cur); - } - while (mp->ps->t1_in_eexec == 0); - t1_start_eexec (mp,fm_cur); - do { - t1_getline (mp); - t1_scan_param (mp,tex_font, fm_cur); - } - while (!(t1_charstrings () || t1_subrs ())); -} - -static void t1_include (MP mp, font_number tex_font, fm_entry *fm_cur) { - do { - t1_getline (mp); - t1_scan_param (mp,tex_font, fm_cur); - t1_putline (mp); - } - while (mp->ps->t1_in_eexec == 0); - t1_start_eexec (mp,fm_cur); - do { - t1_getline (mp); - t1_scan_param (mp,tex_font, fm_cur); - t1_putline (mp); - } - while (!(t1_charstrings () || t1_subrs ())); - mp->ps->t1_cs = true; - do { - t1_getline (mp); - t1_putline (mp); - } - while (!t1_end_eexec ()); - t1_stop_eexec (mp); - if (fixedcontent) { /* copy 512 zeros (not needed for PDF) */ - do { - t1_getline (mp); - t1_putline (mp); - } - while (!t1_cleartomark ()); - t1_check_end (mp); /* write "{restore}if" if found */ - } -} - -@ -@d check_subr(SUBR) if (SUBR >= mp->ps->subr_size || SUBR < 0) { - char s[128]; - mp_snprintf(s,128,"Subrs array: entry index out of range (%i)",SUBR); - mp_fatal_error(mp,s); - } - -@c -static const char **check_cs_token_pair (MP mp) { - const char **p = (const char **) cs_token_pairs_list; - for (; p[0] != NULL; ++p) - if (t1_buf_prefix (p[0]) && t1_buf_suffix (p[1])) - return p; - return NULL; -} - -static void cs_store (MP mp, boolean is_subr) { - char *p; - cs_entry *ptr; - int subr; - for (p = mp->ps->t1_line_array, mp->ps->t1_buf_ptr = mp->ps->t1_buf_array; *p != ' '; - *mp->ps->t1_buf_ptr++ = *p++); - *mp->ps->t1_buf_ptr = 0; - if (is_subr) { - subr = (int)t1_scan_num (mp, p + 1, 0); - check_subr (subr); - ptr = mp->ps->subr_tab + subr; - } else { - ptr = mp->ps->cs_ptr++; - if (mp->ps->cs_ptr - mp->ps->cs_tab > mp->ps->cs_size) { - char s[128]; - mp_snprintf(s,128,"CharStrings dict: more entries than dict size (%i)",mp->ps->cs_size); - mp_fatal_error(mp,s); - } - if (strcmp (mp->ps->t1_buf_array + 1, notdef) == 0) /* skip the slash */ - ptr->glyph_name = (char *) notdef; - else - ptr->glyph_name = mp_xstrdup (mp,mp->ps->t1_buf_array + 1); - } - /* copy " RD " + cs data to |mp->ps->t1_buf_array| */ - memcpy (mp->ps->t1_buf_array, mp->ps->t1_line_array + mp->ps->cs_start - 4, - (size_t) (mp->ps->t1_cslen + 4)); - /* copy the end of cs data to |mp->ps->t1_buf_array| */ - for (p = mp->ps->t1_line_array + mp->ps->cs_start + mp->ps->t1_cslen, mp->ps->t1_buf_ptr = - mp->ps->t1_buf_array + mp->ps->t1_cslen + 4; *p != 10; *mp->ps->t1_buf_ptr++ = *p++); - *mp->ps->t1_buf_ptr++ = 10; - if (is_subr && mp->ps->cs_token_pair == NULL) - mp->ps->cs_token_pair = check_cs_token_pair (mp); - ptr->len = (unsigned short)(mp->ps->t1_buf_ptr - mp->ps->t1_buf_array); - ptr->cslen = mp->ps->t1_cslen; - ptr->data = mp_xmalloc (mp, (size_t)ptr->len , sizeof (byte)); - memcpy (ptr->data, mp->ps->t1_buf_array, (size_t)ptr->len); - ptr->valid = true; -} - -#define store_subr(mp) cs_store(mp,true) -#define store_cs(mp) cs_store(mp,false) - -#define CC_STACK_SIZE 24 - -static integer cc_stack[CC_STACK_SIZE], *stack_ptr = cc_stack; -static cc_entry cc_tab[CS_MAX]; -static boolean is_cc_init = false; - - -#define cc_pop(N) \ - if (stack_ptr - cc_stack < (N)) \ - stack_error(N); \ - stack_ptr -= N - -#define stack_error(N) { \ - char s[256]; \ - mp_snprintf(s,255,"CharString: invalid access (%i) to stack (%i entries)", \ - (int) N, (int)(stack_ptr - cc_stack)); \ - mp_warn(mp,s); \ - goto cs_error; \ -} - - -#define cc_get(N) ((N) < 0 ? *(stack_ptr + (N)) : *(cc_stack + (N))) - -#define cc_push(V) *stack_ptr++ = V -#define cc_clear() stack_ptr = cc_stack - -#define set_cc(N, B, A, C) \ - cc_tab[N].nargs = A; \ - cc_tab[N].bottom = B; \ - cc_tab[N].clear = C; \ - cc_tab[N].valid = true - -static void cc_init (void) { - int i; - if (is_cc_init) - return; - for (i = 0; i < CS_MAX; i++) - cc_tab[i].valid = false; - set_cc (CS_HSTEM, true, 2, true); - set_cc (CS_VSTEM, true, 2, true); - set_cc (CS_VMOVETO, true, 1, true); - set_cc (CS_RLINETO, true, 2, true); - set_cc (CS_HLINETO, true, 1, true); - set_cc (CS_VLINETO, true, 1, true); - set_cc (CS_RRCURVETO, true, 6, true); - set_cc (CS_CLOSEPATH, false, 0, true); - set_cc (CS_CALLSUBR, false, 1, false); - set_cc (CS_RETURN, false, 0, false); - /* - |set_cc(CS_ESCAPE, false, 0, false);| - */ - set_cc (CS_HSBW, true, 2, true); - set_cc (CS_ENDCHAR, false, 0, true); - set_cc (CS_RMOVETO, true, 2, true); - set_cc (CS_HMOVETO, true, 1, true); - set_cc (CS_VHCURVETO, true, 4, true); - set_cc (CS_HVCURVETO, true, 4, true); - set_cc (CS_DOTSECTION, false, 0, true); - set_cc (CS_VSTEM3, true, 6, true); - set_cc (CS_HSTEM3, true, 6, true); - set_cc (CS_SEAC, true, 5, true); - set_cc (CS_SBW, true, 4, true); - set_cc (CS_DIV, false, 2, false); - set_cc (CS_CALLOTHERSUBR, false, 0, false); - set_cc (CS_POP, false, 0, false); - set_cc (CS_SETCURRENTPOINT, true, 2, true); - is_cc_init = true; -} - -@ - -@d cs_getchar(mp) cdecrypt(*data++, &cr) - -@d mark_subr(mp,n) cs_mark(mp,0, n) -@d mark_cs(mp,s) cs_mark(mp,s, 0) -@d SMALL_BUF_SIZE 256 - -@c -static void cs_warn (MP mp, const char *cs_name, int subr, const char *fmt, ...) { - char buf[SMALL_BUF_SIZE]; - char s[300]; - va_list args; - va_start (args, fmt); - @= /*@@-bufferoverflowhigh@@*/ @> - (void)vsprintf (buf, fmt, args); - @= /*@@=bufferoverflowhigh@@*/ @> - va_end (args); - if (cs_name == NULL) { - mp_snprintf(s,299,"Subr (%i): %s", (int) subr, buf); - } else { - mp_snprintf(s,299,"CharString (/%s): %s", cs_name, buf); - } - mp_warn(mp,s); -} - -static void cs_mark (MP mp, const char *cs_name, int subr) -{ - byte *data; - int i, b, cs_len; - integer a, a1, a2; - unsigned short cr; - static integer lastargOtherSubr3 = 3; /* the argument of last call to - OtherSubrs[3] */ - cs_entry *ptr; - cc_entry *cc; - if (cs_name == NULL) { - check_subr (subr); - ptr = mp->ps->subr_tab + subr; - if (!ptr->valid) - return; - } else { - if (mp->ps->cs_notdef != NULL && - (cs_name == notdef || strcmp (cs_name, notdef) == 0)) - ptr = mp->ps->cs_notdef; - else { - for (ptr = mp->ps->cs_tab; ptr < mp->ps->cs_ptr; ptr++) - if (strcmp (ptr->glyph_name, cs_name) == 0) - break; - if (ptr == mp->ps->cs_ptr) { - char s[128]; - mp_snprintf (s,128,"glyph `%s' undefined", cs_name); - mp_warn(mp,s); - return; - } - if (ptr->glyph_name == notdef) - mp->ps->cs_notdef = ptr; - } - } - /* only marked CharString entries and invalid entries can be skipped; - valid marked subrs must be parsed to keep the stack in sync */ - if (!ptr->valid || (ptr->is_used && cs_name != NULL)) - return; - ptr->is_used = true; - cr = 4330; - cs_len = (int)ptr->cslen; - data = ptr->data + 4; - for (i = 0; i < mp->ps->t1_lenIV; i++, cs_len--) - (void)cs_getchar (mp); - while (cs_len > 0) { - --cs_len; - b = cs_getchar (mp); - if (b >= 32) { - if (b <= 246) - a = b - 139; - else if (b <= 250) { - --cs_len; - a = (int)((unsigned)(b - 247) << 8) + 108 + cs_getchar (mp); - } else if (b <= 254) { - --cs_len; - a = -(int)((unsigned)(b - 251) << 8) - 108 - cs_getchar (mp); - } else { - cs_len -= 4; - a = (cs_getchar (mp) & 0xff) << 24; - a |= (cs_getchar (mp) & 0xff) << 16; - a |= (cs_getchar (mp) & 0xff) << 8; - a |= (cs_getchar (mp) & 0xff) << 0; - if (sizeof (integer) > 4 && (a & 0x80000000)) - a |= ~0x7FFFFFFF; - } - cc_push (a); - } else { - if (b == CS_ESCAPE) { - b = cs_getchar (mp) + CS_1BYTE_MAX; - cs_len--; - } - if (b >= CS_MAX) { - cs_warn (mp,cs_name, subr, "command value out of range: %i", - (int) b); - goto cs_error; - } - cc = cc_tab + b; - if (!cc->valid) { - cs_warn (mp,cs_name, subr, "command not valid: %i", (int) b); - goto cs_error; - } - if (cc->bottom) { - if (stack_ptr - cc_stack < cc->nargs) - cs_warn (mp,cs_name, subr, - "less arguments on stack (%i) than required (%i)", - (int) (stack_ptr - cc_stack), (int) cc->nargs); - else if (stack_ptr - cc_stack > cc->nargs) - cs_warn (mp,cs_name, subr, - "more arguments on stack (%i) than required (%i)", - (int) (stack_ptr - cc_stack), (int) cc->nargs); - } - switch (cc - cc_tab) { - case CS_CALLSUBR: - a1 = cc_get (-1); - cc_pop (1); - mark_subr (mp,a1); - if (!mp->ps->subr_tab[a1].valid) { - cs_warn (mp,cs_name, subr, "cannot call subr (%i)", (int) a1); - goto cs_error; - } - break; - case CS_DIV: - cc_pop (2); - cc_push (0); - break; - case CS_CALLOTHERSUBR: - if (cc_get (-1) == 3) - lastargOtherSubr3 = cc_get (-3); - a1 = cc_get (-2) + 2; - cc_pop (a1); - break; - case CS_POP: - cc_push (lastargOtherSubr3); - /* the only case when we care about the value being pushed onto - stack is when POP follows CALLOTHERSUBR (changing hints by - OtherSubrs[3]) - */ - break; - case CS_SEAC: - a1 = cc_get (3); - a2 = cc_get (4); - cc_clear (); - mark_cs (mp,standard_glyph_names[a1]); - mark_cs (mp,standard_glyph_names[a2]); - break; - default: - if (cc->clear) - cc_clear (); - } - } - } - return; - cs_error: /* an error occured during parsing */ - cc_clear (); - ptr->valid = false; - ptr->is_used = false; -} - -static void t1_subset_ascii_part (MP mp, font_number tex_font, fm_entry *fm_cur) -{ - int i, j; - t1_getline (mp); - while (!t1_prefix ("/Encoding")) { - t1_scan_param (mp,tex_font, fm_cur); - t1_putline (mp); - t1_getline (mp); - } - t1_builtin_enc (mp); - if (is_reencoded (fm_cur)) - mp->ps->t1_glyph_names = external_enc (); - else - mp->ps->t1_glyph_names = mp->ps->t1_builtin_glyph_names; - /* - |if (is_included (fm_cur) && is_subsetted (fm_cur)) { - make_subset_tag (fm_cur, t1_glyph_names, tex_font); - update_subset_tag (); - }| - */ - if ((!is_subsetted (fm_cur)) && mp->ps->t1_encoding == ENC_STANDARD) - t1_puts (mp,"/Encoding StandardEncoding def\n"); - else { - t1_puts - (mp,"/Encoding 256 array\n0 1 255 {1 index exch /.notdef put} for\n"); - for (i = 0, j = 0; i < 256; i++) { - if (is_used_char (i) && mp->ps->t1_glyph_names[i] != notdef) { - j++; - mp_snprintf (mp->ps->t1_line_array, (int)mp->ps->t1_line_limit, - "dup %i /%s put\n", (int) t1_char (i), - mp->ps->t1_glyph_names[i]); - t1_puts(mp,mp->ps->t1_line_array); - } - } - /* We didn't mark anything for the Encoding array. */ - /* We add "dup 0 /.notdef put" for compatibility */ - /* with Acrobat 5.0. */ - if (j == 0) - t1_puts (mp,"dup 0 /.notdef put\n"); - t1_puts (mp,"readonly def\n"); - } - do { - t1_getline (mp); - t1_scan_param (mp,tex_font, fm_cur); - if (!t1_prefix ("/UniqueID")) /* ignore UniqueID for subsetted fonts */ - t1_putline (mp); - } - while (mp->ps->t1_in_eexec == 0); -} - -#define t1_subr_flush(mp) t1_flush_cs(mp,true) -#define t1_cs_flush(mp) t1_flush_cs(mp,false) - -static void cs_init (MP mp) { - mp->ps->cs_ptr = mp->ps->cs_tab = NULL; - mp->ps->cs_dict_start = mp->ps->cs_dict_end = NULL; - mp->ps->cs_count = mp->ps->cs_size = mp->ps->cs_size_pos = 0; - mp->ps->cs_token_pair = NULL; - mp->ps->subr_tab = NULL; - mp->ps->subr_array_start = mp->ps->subr_array_end = NULL; - mp->ps->subr_max = mp->ps->subr_size = mp->ps->subr_size_pos = 0; -} - -static void init_cs_entry ( cs_entry * cs) { - cs->data = NULL; - cs->glyph_name = NULL; - cs->len = 0; - cs->cslen = 0; - cs->is_used = false; - cs->valid = false; -} - -static void t1_mark_glyphs (MP mp, font_number tex_font); - -static void t1_read_subrs (MP mp, font_number tex_font, fm_entry *fm_cur) -{ - int i, s; - cs_entry *ptr; - t1_getline (mp); - while (!(t1_charstrings () || t1_subrs ())) { - t1_scan_param (mp,tex_font, fm_cur); - t1_putline (mp); - t1_getline (mp); - } - FOUND: - mp->ps->t1_cs = true; - mp->ps->t1_scan = false; - if (!t1_subrs ()) - return; - mp->ps->subr_size_pos = (int)(strlen ("/Subrs") + 1); - /* |subr_size_pos| points to the number indicating dict size after "/Subrs" */ - mp->ps->subr_size = (int)t1_scan_num (mp,mp->ps->t1_line_array + mp->ps->subr_size_pos, 0); - if (mp->ps->subr_size == 0) { - while (!t1_charstrings ()) - t1_getline (mp); - return; - } - /* |subr_tab = xtalloc (subr_size, cs_entry);| */ - mp->ps->subr_tab = (cs_entry *)mp_xmalloc (mp,(size_t)mp->ps->subr_size, sizeof (cs_entry)); - for (ptr = mp->ps->subr_tab; ptr - mp->ps->subr_tab < mp->ps->subr_size; ptr++) - init_cs_entry (ptr); - mp->ps->subr_array_start = mp_xstrdup (mp,mp->ps->t1_line_array); - t1_getline (mp); - while (mp->ps->t1_cslen) { - store_subr (mp); - t1_getline (mp); - } - /* mark the first four entries without parsing */ - for (i = 0; i < mp->ps->subr_size && i < 4; i++) - mp->ps->subr_tab[i].is_used = true; - /* the end of the Subrs array might have more than one line so we need to - concatnate them to |subr_array_end|. Unfortunately some fonts don't have - the Subrs array followed by the CharStrings dict immediately (synthetic - fonts). If we cannot find CharStrings in next |POST_SUBRS_SCAN| lines then - we will treat the font as synthetic and ignore everything until next - Subrs is found - */ -#define POST_SUBRS_SCAN 5 - s = 0; - *mp->ps->t1_buf_array = 0; - for (i = 0; i < POST_SUBRS_SCAN; i++) { - if (t1_charstrings ()) - break; - s += mp->ps->t1_line_ptr - mp->ps->t1_line_array; - alloc_array (t1_buf, s, T1_BUF_SIZE); - strcat (mp->ps->t1_buf_array, mp->ps->t1_line_array); - t1_getline (mp); - } - mp->ps->subr_array_end = mp_xstrdup (mp,mp->ps->t1_buf_array); - if (i == POST_SUBRS_SCAN) { /* CharStrings not found; - suppose synthetic font */ - for (ptr = mp->ps->subr_tab; ptr - mp->ps->subr_tab < mp->ps->subr_size; ptr++) - if (ptr->valid) - mp_xfree (ptr->data); - mp_xfree (mp->ps->subr_tab); - mp_xfree (mp->ps->subr_array_start); - mp_xfree (mp->ps->subr_array_end); - cs_init (mp); - mp->ps->t1_cs = false; - mp->ps->t1_synthetic = true; - while (!(t1_charstrings () || t1_subrs ())) - t1_getline (mp); - goto FOUND; - } -} - -@ @c -static void t1_flush_cs (MP mp, boolean is_subr) -{ - char *p; - byte *r, *return_cs = NULL; - cs_entry *tab, *end_tab, *ptr; - char *start_line, *line_end; - int count, size_pos; - unsigned short cr, cs_len = 0; /* to avoid warning about uninitialized use of |cs_len| */ - if (is_subr) { - start_line = mp->ps->subr_array_start; - line_end = mp->ps->subr_array_end; - size_pos = mp->ps->subr_size_pos; - tab = mp->ps->subr_tab; - count = mp->ps->subr_max + 1; - end_tab = mp->ps->subr_tab + count; - } else { - start_line = mp->ps->cs_dict_start; - line_end = mp->ps->cs_dict_end; - size_pos = mp->ps->cs_size_pos; - tab = mp->ps->cs_tab; - end_tab = mp->ps->cs_ptr; - count = mp->ps->cs_count; - } - mp->ps->t1_line_ptr = mp->ps->t1_line_array; - for (p = start_line; p - start_line < size_pos;) - *mp->ps->t1_line_ptr++ = *p++; - while (mp_isdigit (*p)) - p++; - mp_snprintf (mp->ps->t1_line_ptr, (int)mp->ps->t1_line_limit, "%u", (unsigned)count); - strcat (mp->ps->t1_line_ptr, p); - mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array); - t1_putline (mp); - - /* create |return_cs| to replace unsused subr's */ - if (is_subr) { - cr = 4330; - cs_len = 0; - return_cs = mp_xmalloc (mp, (size_t)(mp->ps->t1_lenIV + 1) , sizeof(byte)); - if ( mp->ps->t1_lenIV > 0) { - for (cs_len = 0, r = return_cs; - cs_len<(unsigned short)mp->ps->t1_lenIV; cs_len++, r++) - *r = cencrypt (0x00, &cr); - *r = cencrypt (CS_RETURN, &cr); - } else { - *return_cs = CS_RETURN; - } - cs_len++; - } - - for (ptr = tab; ptr < end_tab; ptr++) { - if (ptr->is_used) { - if (is_subr) - mp_snprintf (mp->ps->t1_line_array, (int)mp->ps->t1_line_limit, - "dup %i %u", (int) (ptr - tab), ptr->cslen); - else - mp_snprintf (mp->ps->t1_line_array, (int)mp->ps->t1_line_limit, - "/%s %u", ptr->glyph_name, ptr->cslen); - p = strend (mp->ps->t1_line_array); - memcpy (p, ptr->data, (size_t)ptr->len); - mp->ps->t1_line_ptr = p + ptr->len; - t1_putline (mp); - } else { - /* replace unsused subr's by |return_cs| */ - if (is_subr) { - mp_snprintf (mp->ps->t1_line_array, (int)mp->ps->t1_line_limit, - "dup %i %u%s ", (int) (ptr - tab), - cs_len, mp->ps->cs_token_pair[0]); - p = strend (mp->ps->t1_line_array); - memcpy (p, return_cs, (size_t)cs_len); - mp->ps->t1_line_ptr = p + cs_len; - t1_putline (mp); - mp_snprintf (mp->ps->t1_line_array, (int)mp->ps->t1_line_limit, - " %s", mp->ps->cs_token_pair[1]); - mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array); - t1_putline (mp); - } - } - mp_xfree (ptr->data); - if (ptr->glyph_name != notdef) - mp_xfree (ptr->glyph_name); - } - mp_snprintf (mp->ps->t1_line_array, (int)mp->ps->t1_line_limit, "%s", line_end); - mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array); - t1_putline (mp); - if (is_subr) - mp_xfree (return_cs); - mp_xfree (tab); - mp_xfree (start_line); - mp_xfree (line_end); -} - -static void t1_mark_glyphs (MP mp, font_number tex_font) -{ - int i; - char *charset = extra_charset (); - char *g, *s, *r; - cs_entry *ptr; - if (mp->ps->t1_synthetic || embed_all_glyphs (tex_font)) { /* mark everything */ - if (mp->ps->cs_tab != NULL) - for (ptr = mp->ps->cs_tab; ptr < mp->ps->cs_ptr; ptr++) - if (ptr->valid) - ptr->is_used = true; - if (mp->ps->subr_tab != NULL) { - for (ptr = mp->ps->subr_tab; ptr - mp->ps->subr_tab < mp->ps->subr_size; ptr++) - if (ptr->valid) - ptr->is_used = true; - mp->ps->subr_max = mp->ps->subr_size - 1; - } - return; - } - mark_cs (mp,notdef); - for (i = 0; i < 256; i++) - if (is_used_char (i)) { - if (mp->ps->t1_glyph_names[i] == notdef) { - char S[128]; - mp_snprintf(S,128, "character %i is mapped to %s", i, notdef); - mp_warn(mp,S); - } else - mark_cs (mp,mp->ps->t1_glyph_names[i]); - } - if (charset == NULL) - goto SET_SUBR_MAX; - g = s = charset + 1; /* skip the first '/' */ - r = strend (g); - while (g < r) { - while (*s != '/' && s < r) - s++; - *s = 0; /* terminate g by rewriting '/' to 0 */ - mark_cs (mp,g); - g = s + 1; - } - SET_SUBR_MAX: - if (mp->ps->subr_tab != NULL) - for (mp->ps->subr_max = -1, ptr = mp->ps->subr_tab; - ptr - mp->ps->subr_tab < mp->ps->subr_size; - ptr++) - if (ptr->is_used && ptr - mp->ps->subr_tab > mp->ps->subr_max) - mp->ps->subr_max = ptr - mp->ps->subr_tab; -} - -static void t1_subset_charstrings (MP mp, font_number tex_font) -{ - cs_entry *ptr; - mp->ps->cs_size_pos = - strstr (mp->ps->t1_line_array, charstringname) + strlen (charstringname) - - mp->ps->t1_line_array + 1; - /* |cs_size_pos| points to the number indicating - dict size after "/CharStrings" */ - mp->ps->cs_size = (int)t1_scan_num (mp,mp->ps->t1_line_array + mp->ps->cs_size_pos, 0); - mp->ps->cs_ptr = mp->ps->cs_tab = mp_xmalloc (mp,(size_t)mp->ps->cs_size, sizeof(cs_entry)); - for (ptr = mp->ps->cs_tab; ptr - mp->ps->cs_tab < mp->ps->cs_size; ptr++) - init_cs_entry (ptr); - mp->ps->cs_notdef = NULL; - mp->ps->cs_dict_start = mp_xstrdup (mp,mp->ps->t1_line_array); - t1_getline (mp); - while (mp->ps->t1_cslen) { - store_cs (mp); - t1_getline (mp); - } - mp->ps->cs_dict_end = mp_xstrdup (mp,mp->ps->t1_line_array); - t1_mark_glyphs (mp,tex_font); - if (mp->ps->subr_tab != NULL) { - if (mp->ps->cs_token_pair == NULL) - mp_fatal_error - (mp, "This Type 1 font uses mismatched subroutine begin/end token pairs."); - t1_subr_flush (mp); - } - for (mp->ps->cs_count = 0, ptr = mp->ps->cs_tab; ptr < mp->ps->cs_ptr; ptr++) - if (ptr->is_used) - mp->ps->cs_count++; - t1_cs_flush (mp); -} - -static void t1_subset_end (MP mp) -{ - if (mp->ps->t1_synthetic) { /* copy to "dup /FontName get exch definefont pop" */ - while (!strstr (mp->ps->t1_line_array, "definefont")) { - t1_getline (mp); - t1_putline (mp); - } - while (!t1_end_eexec ()) - t1_getline (mp); /* ignore the rest */ - t1_putline (mp); /* write "mark currentfile closefile" */ - } else - while (!t1_end_eexec ()) { /* copy to "mark currentfile closefile" */ - t1_getline (mp); - t1_putline (mp); - } - t1_stop_eexec (mp); - if (fixedcontent) { /* copy 512 zeros (not needed for PDF) */ - while (!t1_cleartomark ()) { - t1_getline (mp); - t1_putline (mp); - } - if (!mp->ps->t1_synthetic) /* don't check "{restore}if" for synthetic fonts */ - t1_check_end (mp); /* write "{restore}if" if found */ - } -} - -static int t1_updatefm (MP mp, font_number f, fm_entry *fm) -{ - char *s, *p; - mp->ps->read_encoding_only = true; - if (!t1_open_fontfile (mp,fm,NULL)) { - return 0; - } - t1_scan_only (mp,f, fm); - s = mp_xstrdup(mp,mp->ps->fontname_buf); - p = s; - while (*p != ' ' && *p != 0) - p++; - *p=0; - fm->ps_name = s; - t1_close_font_file (mp,""); - return 1; -} - - -static void writet1 (MP mp, font_number tex_font, fm_entry *fm_cur) { - unsigned save_selector = mp->selector; - mp_normalize_selector(mp); - mp->ps->read_encoding_only = false; - if (!is_included (fm_cur)) { /* scan parameters from font file */ - if (!t1_open_fontfile (mp,fm_cur,"{")) - return; - t1_scan_only (mp,tex_font, fm_cur); - t1_close_font_file (mp,"}"); - return; - } - if (!is_subsetted (fm_cur)) { /* include entire font */ - if (!t1_open_fontfile (mp,fm_cur,"<<")) - return; - t1_include (mp,tex_font,fm_cur); - t1_close_font_file (mp,">>"); - return; - } - /* partial downloading */ - if (!t1_open_fontfile (mp,fm_cur,"<")) - return; - t1_subset_ascii_part (mp,tex_font,fm_cur); - t1_start_eexec (mp,fm_cur); - cc_init (); - cs_init (mp); - t1_read_subrs (mp,tex_font, fm_cur); - t1_subset_charstrings (mp,tex_font); - t1_subset_end (mp); - t1_close_font_file (mp,">"); - mp->selector = save_selector; -} - -@ @<Declarations@>= -static void t1_free (MP mp); - -@ @c -static void t1_free (MP mp) { - mp_xfree (mp->ps->t1_line_array); - mp_xfree (mp->ps->t1_buf_array); -} - - -@* \[44d] Embedding fonts. - -@ The |tfm_num| is officially of type |font_number|, but that -type does not exist yet at this point in the output order. - -@<Types...@>= -typedef struct { - char *tfm_name; /* TFM file name */ - char *ps_name; /* PostScript name */ - integer flags; /* font flags */ - char *ff_name; /* font file name */ - char *subset_tag; /* pseudoUniqueTag for subsetted font */ - enc_entry *encoding; /* pointer to corresponding encoding */ - unsigned int tfm_num; /* number of the TFM refering this entry */ - unsigned short type; /* font type (T1/TTF/...) */ - short slant; /* SlantFont */ - short extend; /* ExtendFont */ - integer ff_objnum; /* FontFile object number */ - integer fn_objnum; /* FontName/BaseName object number */ - integer fd_objnum; /* FontDescriptor object number */ - char *charset; /* string containing used glyphs */ - boolean all_glyphs; /* embed all glyphs? */ - unsigned short links; /* link flags from |tfm_tree| and |ps_tree| */ - short tfm_avail; /* flags whether a tfm is available */ - short pid; /* Pid for truetype fonts */ - short eid; /* Eid for truetype fonts */ -} fm_entry; - - -@ -@<Glob...@>= -#define FONTNAME_BUF_SIZE 128 -boolean fontfile_found; -boolean is_otf_font; -char fontname_buf[FONTNAME_BUF_SIZE]; - -@ -@d F_INCLUDED 0x01 -@d F_SUBSETTED 0x02 -@d F_TRUETYPE 0x04 -@d F_BASEFONT 0x08 - -@d set_included(fm) ((fm)->type |= F_INCLUDED) -@d set_subsetted(fm) ((fm)->type |= F_SUBSETTED) -@d set_truetype(fm) ((fm)->type |= F_TRUETYPE) -@d set_basefont(fm) ((fm)->type |= F_BASEFONT) - -@d is_included(fm) ((fm)->type & F_INCLUDED) -@d is_subsetted(fm) ((fm)->type & F_SUBSETTED) -@d is_truetype(fm) ((fm)->type & F_TRUETYPE) -@d is_basefont(fm) ((fm)->type & F_BASEFONT) -@d is_reencoded(fm) ((fm)->encoding != NULL) -@d is_fontfile(fm) (fm_fontfile(fm) != NULL) -@d is_t1fontfile(fm) (is_fontfile(fm) && !is_truetype(fm)) - -@d fm_slant(fm) (fm)->slant -@d fm_extend(fm) (fm)->extend -@d fm_fontfile(fm) (fm)->ff_name - -@<Declarations@>= -static boolean mp_font_is_reencoded (MP mp, font_number f); -static boolean mp_font_is_included (MP mp, font_number f); -static boolean mp_font_is_subsetted (MP mp, font_number f); - -@ @c -boolean mp_font_is_reencoded (MP mp, font_number f) { - fm_entry *fm; - if (mp_has_font_size(mp,f) && mp_has_fm_entry (mp, f, &fm)) { - if (fm != NULL - && (fm->ps_name != NULL) - && is_reencoded (fm)) - return true; - } - return false; -} -boolean mp_font_is_included (MP mp, font_number f) { - fm_entry *fm; - if (mp_has_font_size(mp,f) && mp_has_fm_entry (mp, f, &fm)) { - if (fm != NULL - && (fm->ps_name != NULL && fm->ff_name != NULL) - && is_included (fm)) - return true; - } - return false; -} -boolean mp_font_is_subsetted (MP mp, font_number f) { - fm_entry *fm; - if (mp_has_font_size(mp,f) && mp_has_fm_entry (mp, f,&fm)) { - if (fm != NULL - && (fm->ps_name != NULL && fm->ff_name != NULL) - && is_included (fm) && is_subsetted (fm)) - return true; - } - return false; -} - -@ @<Declarations@>= -static char * mp_fm_encoding_name (MP mp, font_number f); -static char * mp_fm_font_name (MP mp, font_number f); -static char * mp_fm_font_subset_name (MP mp, font_number f); - -@ -@c char * mp_fm_encoding_name (MP mp, font_number f) { - enc_entry *e; - fm_entry *fm; - if (mp_has_fm_entry (mp, f, &fm)) { - if (fm != NULL && (fm->ps_name != NULL)) { - if (is_reencoded (fm)) { - e = fm->encoding; - if (e->enc_name!=NULL) - return mp_xstrdup(mp,e->enc_name); - } else { - return NULL; - } - } - } - print_err ("fontmap encoding problems for font "); - mp_print(mp,mp->font_name[f]); - mp_error(mp); - return NULL; -} -char * mp_fm_font_name (MP mp, font_number f) { - fm_entry *fm; - if (mp_has_fm_entry (mp, f,&fm)) { - if (fm != NULL && (fm->ps_name != NULL)) { - if (mp_font_is_included(mp, f) && !mp->font_ps_name_fixed[f]) { - /* find the real fontname, and update |ps_name| and |subset_tag| if needed */ - if (t1_updatefm(mp,f,fm)) { - mp->font_ps_name_fixed[f] = true; - } else { - print_err ("font loading problems for font "); - mp_print(mp,mp->font_name[f]); - mp_error(mp); - } - } - return mp_xstrdup(mp,fm->ps_name); - } - } - print_err ("fontmap name problems for font "); - mp_print(mp,mp->font_name[f]); - mp_error(mp); - return NULL; -} - -static char * mp_fm_font_subset_name (MP mp, font_number f) { - fm_entry *fm; - if (mp_has_fm_entry (mp, f, &fm)) { - if (fm != NULL && (fm->ps_name != NULL)) { - if (is_subsetted(fm)) { - char *s = mp_xmalloc(mp,strlen(fm->ps_name)+8,1); - mp_snprintf(s,(int)strlen(fm->ps_name)+8,"%s-%s",fm->subset_tag,fm->ps_name); - return s; - } else { - return mp_xstrdup(mp,fm->ps_name); - } - } - } - print_err ("fontmap name problems for font "); - mp_print(mp,mp->font_name[f]); - mp_error(mp); - return NULL; -} - -@ @<Declarations@>= -static integer mp_fm_font_slant (MP mp, font_number f); -static integer mp_fm_font_extend (MP mp, font_number f); - -@ -@c static integer mp_fm_font_slant (MP mp, font_number f) { - fm_entry *fm; - if (mp_has_fm_entry (mp, f, &fm)) { - if (fm != NULL && (fm->ps_name != NULL)) { - return fm->slant; - } - } - return 0; -} -static integer mp_fm_font_extend (MP mp, font_number f) { - fm_entry *fm; - if (mp_has_fm_entry (mp, f, &fm)) { - if (fm != NULL && (fm->ps_name != NULL)) { - return fm->extend; - } - } - return 0; -} - -@ @<Declarations@>= -static boolean mp_do_ps_font (MP mp, font_number f); - -@ @c static boolean mp_do_ps_font (MP mp, font_number f) { - fm_entry *fm_cur; - (void)mp_has_fm_entry (mp, f, &fm_cur); /* for side effects */ - if (fm_cur == NULL) - return true; - if (is_truetype(fm_cur) || - (fm_cur->ps_name == NULL && fm_cur->ff_name == NULL)) { - return false; - } - if (is_included(fm_cur)) { - mp_ps_print_nl(mp,"%%BeginResource: font "); - if (is_subsetted(fm_cur)) { - mp_ps_print(mp, fm_cur->subset_tag); - mp_ps_print_char(mp,'-'); - } - mp_ps_print(mp, fm_cur->ps_name); - mp_ps_print_ln(mp); - writet1 (mp,f,fm_cur); - mp_ps_print_nl(mp,"%%EndResource"); - mp_ps_print_ln(mp); - } - return true; -} - -@ Included subset fonts do not need and encoding vector, make -sure we skip that case. - -@<Declarations@>= -static void mp_list_used_resources (MP mp, int prologues, int procset); - -@ @c static void mp_list_used_resources (MP mp, int prologues, int procset) { - font_number f; /* fonts used in a text node or as loop counters */ - int ff; /* a loop counter */ - int ldf; /* the last \.{DocumentFont} listed (otherwise |null_font|) */ - boolean firstitem; - if ( procset>0 ) - mp_ps_print_nl(mp, "%%DocumentResources: procset mpost"); - else - mp_ps_print_nl(mp, "%%DocumentResources: procset mpost-minimal"); - ldf=null_font; - firstitem=true; - for (f=null_font+1;f<=mp->last_fnum;f++) { - if ( (mp_has_font_size(mp,f))&&(mp_font_is_reencoded(mp,f)) ) { - for (ff=ldf;ff>=null_font;ff--) { - if ( mp_has_font_size(mp,(font_number)ff) ) - if ( mp_xstrcmp(mp->font_enc_name[f],mp->font_enc_name[ff])==0 ) - goto FOUND; - } - if ( mp_font_is_subsetted(mp,f) ) - goto FOUND; - if ( mp->ps->ps_offset+1+strlen(mp->font_enc_name[f])> - (size_t)mp->max_print_line ) - mp_ps_print_nl(mp, "%%+ encoding"); - if ( firstitem ) { - firstitem=false; - mp_ps_print_nl(mp, "%%+ encoding"); - } - mp_ps_print_char(mp, ' '); - mp_ps_print(mp, mp->font_enc_name[f]); - ldf=(int)f; - } - FOUND: - ; - } - ldf=null_font; - firstitem=true; - for (f=null_font+1;f<=mp->last_fnum;f++) { - if ( mp_has_font_size(mp,f) ) { - for (ff=ldf;ff>=null_font;ff--) { - if ( mp_has_font_size(mp,(font_number)ff) ) - if ( mp_xstrcmp(mp->font_name[f],mp->font_name[ff])==0 ) - goto FOUND2; - } - if ( mp->ps->ps_offset+1+strlen(mp->font_ps_name[f])> - (size_t)mp->max_print_line ) - mp_ps_print_nl(mp, "%%+ font"); - if ( firstitem ) { - firstitem=false; - mp_ps_print_nl(mp, "%%+ font"); - } - mp_ps_print_char(mp, ' '); - if ( (prologues==3)&& - (mp_font_is_subsetted(mp,f)) ) - mp_ps_print(mp, mp_fm_font_subset_name(mp,f)); - else - mp_ps_print(mp, mp->font_ps_name[f]); - ldf=(int)f; - } - FOUND2: - ; - } - mp_ps_print_ln(mp); -} - -@ @<Declarations@>= -static void mp_list_supplied_resources (MP mp, int prologues, int procset); - -@ @c static void mp_list_supplied_resources (MP mp, int prologues, int procset) { - font_number f; /* fonts used in a text node or as loop counters */ - int ff; /* a loop counter */ - int ldf; /* the last \.{DocumentFont} listed (otherwise |null_font|) */ - boolean firstitem; - if ( procset>0 ) - mp_ps_print_nl(mp, "%%DocumentSuppliedResources: procset mpost"); - else - mp_ps_print_nl(mp, "%%DocumentSuppliedResources: procset mpost-minimal"); - ldf=null_font; - firstitem=true; - for (f=null_font+1;f<=mp->last_fnum;f++) { - if ( (mp_has_font_size(mp,f))&&(mp_font_is_reencoded(mp,f)) ) { - for (ff=ldf;ff>= null_font;ff++) { - if ( mp_has_font_size(mp,(font_number)ff) ) - if ( mp_xstrcmp(mp->font_enc_name[f],mp->font_enc_name[ff])==0 ) - goto FOUND; - } - if ( (prologues==3)&&(mp_font_is_subsetted(mp,f))) - goto FOUND; - if ( mp->ps->ps_offset+1+strlen(mp->font_enc_name[f])>(size_t)mp->max_print_line ) - mp_ps_print_nl(mp, "%%+ encoding"); - if ( firstitem ) { - firstitem=false; - mp_ps_print_nl(mp, "%%+ encoding"); - } - mp_ps_print_char(mp, ' '); - mp_ps_print(mp, mp->font_enc_name[f]); - ldf=(int)f; - } - FOUND: - ; - } - ldf=null_font; - firstitem=true; - if (prologues==3) { - for (f=null_font+1;f<=mp->last_fnum;f++) { - if ( mp_has_font_size(mp,f) ) { - for (ff=ldf;ff>= null_font;ff--) { - if ( mp_has_font_size(mp,(font_number)ff) ) - if ( mp_xstrcmp(mp->font_name[f],mp->font_name[ff])==0 ) - goto FOUND2; - } - if ( ! mp_font_is_included(mp,f) ) - goto FOUND2; - if ( mp->ps->ps_offset+1+strlen(mp->font_ps_name[f])>(size_t)mp->max_print_line ) - mp_ps_print_nl(mp, "%%+ font"); - if ( firstitem ) { - firstitem=false; - mp_ps_print_nl(mp, "%%+ font"); - } - mp_ps_print_char(mp, ' '); - if ( mp_font_is_subsetted(mp,f) ) - mp_ps_print(mp, mp_fm_font_subset_name(mp,f)); - else - mp_ps_print(mp, mp->font_ps_name[f]); - ldf=(int)f; - } - FOUND2: - ; - } - mp_ps_print_ln(mp); - } -} - -@ @<Declarations...@>= -static void mp_list_needed_resources (MP mp, int prologues); - -@ @c static void mp_list_needed_resources (MP mp, int prologues) { - font_number f; /* fonts used in a text node or as loop counters */ - int ff; /* a loop counter */ - int ldf; /* the last \.{DocumentFont} listed (otherwise |null_font|) */ - boolean firstitem; - ldf=null_font; - firstitem=true; - for (f=null_font+1;f<=mp->last_fnum;f++ ) { - if ( mp_has_font_size(mp,f)) { - for (ff=ldf;ff>=null_font;ff--) { - if ( mp_has_font_size(mp,(font_number)ff) ) - if ( mp_xstrcmp(mp->font_name[f],mp->font_name[ff])==0 ) - goto FOUND; - }; - if ((prologues==3)&&(mp_font_is_included(mp,f)) ) - goto FOUND; - if ( mp->ps->ps_offset+1+strlen(mp->font_ps_name[f])>(size_t)mp->max_print_line ) - mp_ps_print_nl(mp, "%%+ font"); - if ( firstitem ) { - firstitem=false; - mp_ps_print_nl(mp, "%%DocumentNeededResources: font"); - } - mp_ps_print_char(mp, ' '); - mp_ps_print(mp, mp->font_ps_name[f]); - ldf=(int)f; - } - FOUND: - ; - } - if ( ! firstitem ) { - mp_ps_print_ln(mp); - ldf=null_font; - firstitem=true; - for (f=null_font+1;f<= mp->last_fnum;f++) { - if ( mp_has_font_size(mp,f) ) { - for (ff=ldf;ff>=null_font;ff-- ) { - if ( mp_has_font_size(mp,(font_number)ff) ) - if ( mp_xstrcmp(mp->font_name[f],mp->font_name[ff])==0 ) - goto FOUND2; - } - if ((prologues==3)&&(mp_font_is_included(mp,f)) ) - goto FOUND2; - mp_ps_print(mp, "%%IncludeResource: font "); - mp_ps_print(mp, mp->font_ps_name[f]); - mp_ps_print_ln(mp); - ldf=(int)f; - } - FOUND2: - ; - } - } -} - -@ @<Declarations@>= -static void mp_write_font_definition (MP mp, font_number f, int prologues); - -@ - -@d applied_reencoding(A) ((mp_font_is_reencoded(mp,(A)))&& - ((! mp_font_is_subsetted(mp,(A)))||(prologues==2))) - -@c static void mp_write_font_definition(MP mp, font_number f, int prologues) { - if ( (applied_reencoding(f))||(mp_fm_font_slant(mp,f)!=0)|| - (mp_fm_font_extend(mp,f)!=0)|| - (mp_xstrcmp(mp->font_name[f],"psyrgo")==0)|| - (mp_xstrcmp(mp->font_name[f],"zpzdr-reversed")==0) ) { - if ( (mp_font_is_subsetted(mp,f))&& - (mp_font_is_included(mp,f))&&(prologues==3)) - mp_ps_name_out(mp, mp_fm_font_subset_name(mp,f),true); - else - mp_ps_name_out(mp, mp->font_ps_name[f],true); - mp_ps_print(mp, " fcp"); - mp_ps_print_ln(mp); - if ( applied_reencoding(f) ) { - mp_ps_print(mp, "/Encoding "); - mp_ps_print(mp, mp->font_enc_name[f]); - mp_ps_print(mp, " def "); - }; - if ( mp_fm_font_slant(mp,f)!=0 ) { - mp_ps_print_int(mp, mp_fm_font_slant(mp,f)); - mp_ps_print(mp, " SlantFont "); - }; - if ( mp_fm_font_extend(mp,f)!=0 ) { - mp_ps_print_int(mp, mp_fm_font_extend(mp,f)); - mp_ps_print(mp, " ExtendFont "); - }; - if ( mp_xstrcmp(mp->font_name[f],"psyrgo")==0 ) { - mp_ps_print(mp, " 890 ScaleFont "); - mp_ps_print(mp, " 277 SlantFont "); - }; - if ( mp_xstrcmp(mp->font_name[f],"zpzdr-reversed")==0 ) { - mp_ps_print(mp, " FontMatrix [-1 0 0 1 0 0] matrix concatmatrix /FontMatrix exch def "); - mp_ps_print(mp, "/Metrics 2 dict dup begin "); - mp_ps_print(mp, "/space[0 -278]def "); - mp_ps_print(mp, "/a12[-904 -939]def "); - mp_ps_print(mp, "end def "); - }; - mp_ps_print(mp, "currentdict end"); - mp_ps_print_ln(mp); - mp_ps_print_defined_name(mp,f,prologues); - mp_ps_print(mp, " exch definefont pop"); - mp_ps_print_ln(mp); - } -} - -@ @<Declarations@>= -static void mp_ps_print_defined_name (MP mp, font_number f, int prologues); - -@ -@c static void mp_ps_print_defined_name(MP mp, font_number f, int prologues) { - mp_ps_print(mp, " /"); - if ((mp_font_is_subsetted(mp,f))&& - (mp_font_is_included(mp,f))&&(prologues==3)) - mp_ps_print(mp, mp_fm_font_subset_name(mp,f)); - else - mp_ps_print(mp, mp->font_ps_name[f]); - if ( mp_xstrcmp(mp->font_name[f],"psyrgo")==0 ) - mp_ps_print(mp, "-Slanted"); - if ( mp_xstrcmp(mp->font_name[f],"zpzdr-reversed")==0 ) - mp_ps_print(mp, "-Reverse"); - if ( applied_reencoding(f) ) { - mp_ps_print(mp, "-"); - mp_ps_print(mp, mp->font_enc_name[f]); - } - if ( mp_fm_font_slant(mp,f)!=0 ) { - mp_ps_print(mp, "-Slant_"); mp_ps_print_int(mp, mp_fm_font_slant(mp,f)) ; - } - if ( mp_fm_font_extend(mp,f)!=0 ) { - mp_ps_print(mp, "-Extend_"); mp_ps_print_int(mp, mp_fm_font_extend(mp,f)); - } -} - -@ @<Include encodings and fonts for edge structure~|h|@>= -mp_font_encodings(mp,mp->last_fnum,(prologues==2)); -@<Embed fonts that are available@> - -@ @<Embed fonts that are available@>= -{ -next_size=0; -@<Make |cur_fsize| a copy of the |font_sizes| array@>; -do { - done_fonts=true; - for (f=null_font+1;f<=mp->last_fnum;f++) { - if ( cur_fsize[f]!=null ) { - if (prologues==3 ) { - if ( ! mp_do_ps_font(mp,f) ) { - if ( mp_has_fm_entry(mp,f, NULL) ) { - print_err("Font embedding failed"); - mp_error(mp); - } - } - } - cur_fsize[f]=link(cur_fsize[f]); - if ( cur_fsize[f]!=null ) { mp_unmark_font(mp, f); done_fonts=false; } - } - } - if ( ! done_fonts ) - @<Increment |next_size| and apply |mark_string_chars| to all text nodes with - that size index@>; -} while (! done_fonts); -} - -@ @<Increment |next_size| and apply |mark_string_chars| to all text nodes...@>= -{ - next_size++; - mp_apply_mark_string_chars(mp, h, next_size); -} - -@ We also need to keep track of which characters are used in text nodes -in the edge structure that is being shipped out. This is done by procedures -that use the left-over |b3| field in the |char_info| words; i.e., -|char_info(f)(c).b3| gives the status of character |c| in font |f|. - -@<Types...@>= -enum mp_char_mark_state {mp_unused=0, mp_used}; - -@ @<Declarations@>= -static void mp_mark_string_chars (MP mp,font_number f, char *s, size_t l) ; - -@ @c -void mp_mark_string_chars (MP mp,font_number f, char *s, size_t l) { - integer b; /* |char_base[f]| */ - int bc,ec; /* only characters between these bounds are marked */ - char *k; /* an index into string |s| */ - b=mp->char_base[f]; - bc=(int)mp->font_bc[f]; - ec=(int)mp->font_ec[f]; - k=s; - while (l-->0){ - if ( (*k>=bc)&&(*k<=ec) ) - mp->font_info[b+*k].qqqq.b3=mp_used; - k++; - } -} - - -@ @<Declarations@>= -static void mp_unmark_font (MP mp,font_number f) ; - -@ @c -void mp_unmark_font (MP mp,font_number f) { - int k; /* an index into |font_info| */ - for (k= mp->char_base[f]+mp->font_bc[f]; - k<=mp->char_base[f]+mp->font_ec[f]; - k++) - mp->font_info[k].qqqq.b3=mp_unused; -} - - -@ @<Declarations@>= -static void mp_print_improved_prologue (MP mp, mp_edge_object *h, int p1, int procset) ; - -@ @c -void mp_print_improved_prologue (MP mp, mp_edge_object *h, int prologues, int procset) { - quarterword next_size; /* the size index for fonts being listed */ - pointer *cur_fsize; /* current positions in |font_sizes| */ - boolean done_fonts; /* have we finished listing the fonts in the header? */ - font_number f; /* a font number for loops */ - cur_fsize = mp_xmalloc(mp,(size_t)(mp->font_max+1),sizeof(pointer)); - mp_list_used_resources(mp, prologues, procset); - mp_list_supplied_resources(mp, prologues, procset); - mp_list_needed_resources(mp, prologues); - mp_ps_print_nl(mp, "%%EndComments"); - mp_ps_print_nl(mp, "%%BeginProlog"); - if ( procset>0 ) - mp_ps_print_nl(mp, "%%BeginResource: procset mpost"); - else - mp_ps_print_nl(mp, "%%BeginResource: procset mpost-minimal"); - mp_ps_print_nl(mp, "/bd{bind def}bind def" - "/fshow {exch findfont exch scalefont setfont show}bd"); - if ( procset>0 ) @<Print the procset@>; - mp_ps_print_nl(mp, "/fcp{findfont dup length dict begin" - "{1 index/FID ne{def}{pop pop}ifelse}forall}bd"); - mp_ps_print_nl(mp, "/fmc{FontMatrix dup length array copy dup dup}bd" - "/fmd{/FontMatrix exch def}bd"); - mp_ps_print_nl(mp, "/Amul{4 -1 roll exch mul 1000 div}bd" - "/ExtendFont{fmc 0 get Amul 0 exch put fmd}bd"); - mp_ps_print_nl(mp, "/ScaleFont{dup fmc 0 get" - " Amul 0 exch put dup dup 3 get Amul 3 exch put fmd}bd"); - mp_ps_print_nl(mp, "/SlantFont{fmc 2 get dup 0 eq{pop 1}if" - " Amul FontMatrix 0 get mul 2 exch put fmd}bd"); - mp_ps_print_nl(mp, "%%EndResource"); - @<Include encodings and fonts for edge structure~|h|@>; - mp_ps_print_nl(mp, "%%EndProlog"); - mp_ps_print_nl(mp, "%%BeginSetup"); - mp_ps_print_ln(mp); - for (f=null_font+1;f<=mp->last_fnum;f++) { - if ( mp_has_font_size(mp,f) ) { - if ( mp_has_fm_entry(mp,f,NULL) ) { - mp_write_font_definition(mp,f, prologues); - mp_ps_name_out(mp, mp->font_name[f],true); - mp_ps_print_defined_name(mp,f, prologues); - mp_ps_print(mp, " def"); - } else { - char s[256]; - mp_snprintf(s,256,"font %s cannot be found in any fontmapfile!", mp->font_name[f]); - mp_warn(mp,s); - mp_ps_name_out(mp, mp->font_name[f],true); - mp_ps_name_out(mp, mp->font_name[f],true); - mp_ps_print(mp, " def"); - } - mp_ps_print_ln(mp); - } - } - mp_ps_print_nl(mp, "%%EndSetup"); - mp_ps_print_nl(mp, "%%Page: 1 1"); - mp_ps_print_ln(mp); - mp_xfree(cur_fsize); -} - -@ @<Declarations@>= -static font_number mp_print_font_comments (MP mp , mp_edge_object *h, int prologues); - - -@ -@c -static font_number mp_print_font_comments (MP mp , mp_edge_object *h, int prologues) { - quarterword next_size; /* the size index for fonts being listed */ - pointer *cur_fsize; /* current positions in |font_sizes| */ - int ff; /* a loop counter */ - boolean done_fonts; /* have we finished listing the fonts in the header? */ - font_number f; /* a font number for loops */ - scaled ds; /* design size and scale factor for a text node */ - int ldf=0; /* the last \.{DocumentFont} listed (otherwise |null_font|) */ - cur_fsize = mp_xmalloc(mp,(size_t)(mp->font_max+1),sizeof(pointer)); - if ( prologues>0 ) { - @<Give a \.{DocumentFonts} comment listing all fonts with non-null - |font_sizes| and eliminate duplicates@>; - } else { - next_size=0; - @<Make |cur_fsize| a copy of the |font_sizes| array@>; - do { done_fonts=true; - for (f=null_font+1;f<=mp->last_fnum;f++) { - if ( cur_fsize[f]!=null ) { - @<Print the \.{\%*Font} comment for font |f| and advance |cur_fsize[f]|@>; - } - if ( cur_fsize[f]!=null ) { mp_unmark_font(mp, f); done_fonts=false; }; - } - if ( ! done_fonts ) { - @<Increment |next_size| and apply |mark_string_chars| to all text nodes with - that size index@>; - } - } while (! done_fonts); - } - mp_xfree(cur_fsize); - return (font_number)ldf; -} - -@ @<Make |cur_fsize| a copy of the |font_sizes| array@>= -for (f=null_font+1;f<= mp->last_fnum;f++) - cur_fsize[f]=mp->font_sizes[f] - -@ It's not a good idea to make any assumptions about the |font_ps_name| entries, -so we carefully remove duplicates. There is no harm in using a slow, brute-force -search. - -@<Give a \.{DocumentFonts} comment listing all fonts with non-null...@>= -{ - ldf=null_font; - for (f=null_font+1;f<= mp->last_fnum;f++) { - if ( mp->font_sizes[f]!=null ) { - if ( ldf==null_font ) - mp_ps_print_nl(mp, "%%DocumentFonts:"); - for (ff=ldf;ff>=null_font;ff--) { - if ( mp->font_sizes[ff]!=null ) - if ( mp_xstrcmp(mp->font_ps_name[f],mp->font_ps_name[ff])==0 ) - goto FOUND; - } - if ( mp->ps->ps_offset+1+strlen(mp->font_ps_name[f])>(size_t)mp->max_print_line ) - mp_ps_print_nl(mp, "%%+"); - mp_ps_print_char(mp, ' '); - mp_ps_print(mp, mp->font_ps_name[f]); - ldf=(int)f; - FOUND: - ; - } - } -} - -@ @c -static void mp_hex_digit_out (MP mp,quarterword d) { - if ( d<10 ) mp_ps_print_char(mp, d+'0'); - else mp_ps_print_char(mp, d+'a'-10); -} - -@ We output the marks as a hexadecimal bit string starting at |c| or -|font_bc[f]|, whichever is greater. If the output has to be truncated -to avoid exceeding |emergency_line_length| the return value says where to -start scanning next time. - -@<Declarations@>= -static halfword mp_ps_marks_out (MP mp,font_number f, eight_bits c); - -@ -@d emergency_line_length 255 - /* \ps\ output lines can be this long in unusual circumstances */ - -@c -static halfword mp_ps_marks_out (MP mp,font_number f, eight_bits c) { - eight_bits bc,ec; /* only encode characters between these bounds */ - integer lim; /* the maximum number of marks to encode before truncating */ - int p; /* |font_info| index for the current character */ - int d; /* used to construct a hexadecimal digit */ - unsigned b; /* used to construct a hexadecimal digit */ - lim=4*(emergency_line_length-mp->ps->ps_offset-4); - bc=mp->font_bc[f]; - ec=mp->font_ec[f]; - if ( c>bc ) bc=c; - @<Restrict the range |bc..ec| so that it contains no unused characters - at either end and has length at most |lim|@>; - @<Print the initial label indicating that the bitmap starts at |bc|@>; - @<Print a hexadecimal encoding of the marks for characters |bc..ec|@>; - while ( (ec<mp->font_ec[f])&&(mp->font_info[p].qqqq.b3==mp_unused) ) { - p++; ec++; - } - return (ec+1); -} - -@ We could save time by setting the return value before the loop that -decrements |ec|, but there is no point in being so tricky. - -@<Restrict the range |bc..ec| so that it contains no unused characters...@>= -p=mp->char_base[f]+bc; -while ( (mp->font_info[p].qqqq.b3==mp_unused)&&(bc<ec) ) { - p++; bc++; -} -if ( ec>=(eight_bits)(bc+lim)) ec=(eight_bits)(bc+lim-1); -p=mp->char_base[f]+ec; -while ( (mp->font_info[p].qqqq.b3==mp_unused)&&(bc<ec) ) { - p--; ec--; -} - -@ @<Print the initial label indicating that the bitmap starts at |bc|@>= -mp_ps_print_char(mp, ' '); -mp_hex_digit_out(mp, (quarterword)bc / 16); -mp_hex_digit_out(mp, (quarterword)bc % 16); -mp_ps_print_char(mp, ':') - -@ - -@<Print a hexadecimal encoding of the marks for characters |bc..ec|@>= -b=8; d=0; -for (p=mp->char_base[f]+bc;p<=mp->char_base[f]+ec;p++) { - if ( b==0 ) { - mp_hex_digit_out(mp, (quarterword)d); - d=0; b=8; - } - if ( mp->font_info[p].qqqq.b3!=mp_unused ) d=d+b; - b=b>>1; -} -mp_hex_digit_out(mp, (quarterword)d) - - -@ Here is a simple function that determines whether there are any marked -characters in font~|f| with character code at least~|c|. - -@<Declarations@>= -static boolean mp_check_ps_marks (MP mp,font_number f, integer c) ; - -@ @c -static boolean mp_check_ps_marks (MP mp,font_number f, integer c) { - int p; /* |font_info| index for the current character */ - for (p=mp->char_base[f]+c;p<=mp->char_base[f]+mp->font_ec[f];p++) { - if ( mp->font_info[p].qqqq.b3==mp_used ) - return true; - } - return false; -} - - -@ If the file name is so long that it can't be printed without exceeding -|emergency_line_length| then there will be missing items in the \.{\%*Font:} -line. We might have to repeat line in order to get the character usage -information to fit within |emergency_line_length|. - -TODO: these two defines are also defined in mp.w! - -@d link(A) mp->mem[(A)].hh.rh /* the |link| field of a memory word */ -@d sc_factor(A) mp->mem[(A)+1].cint /* the scale factor stored in a font size node */ - -@<Print the \.{\%*Font} comment for font |f| and advance |cur_fsize[f]|@>= -{ integer t=0; - while ( mp_check_ps_marks(mp, f,t) ) { - mp_ps_print_nl(mp, "%*Font: "); - if ( mp->ps->ps_offset+strlen(mp->font_name[f])+12>emergency_line_length ) - break; - mp_ps_print(mp, mp->font_name[f]); - mp_ps_print_char(mp, ' '); - ds=(mp->font_dsize[f] + 8) / 16; - mp_ps_print_scaled(mp, mp_take_scaled(mp, ds,sc_factor(cur_fsize[f]))); - if ( mp->ps->ps_offset+12>emergency_line_length ) break; - mp_ps_print_char(mp, ' '); - mp_ps_print_scaled(mp, ds); - if ( mp->ps->ps_offset+5>emergency_line_length ) break; - t=mp_ps_marks_out(mp, f, (eight_bits)t); - } - cur_fsize[f]=link(cur_fsize[f]); -} - -@ @<Print the procset@>= -{ - mp_ps_print_nl(mp, "/hlw{0 dtransform exch truncate exch idtransform pop setlinewidth}bd"); - mp_ps_print_nl(mp, "/vlw{0 exch dtransform truncate idtransform setlinewidth pop}bd"); - mp_ps_print_nl(mp, "/l{lineto}bd/r{rlineto}bd/c{curveto}bd/m{moveto}bd" - "/p{closepath}bd/n{newpath}bd"); - mp_ps_print_nl(mp, "/C{setcmykcolor}bd/G{setgray}bd/R{setrgbcolor}bd" - "/lj{setlinejoin}bd/ml{setmiterlimit}bd"); - mp_ps_print_nl(mp, "/lc{setlinecap}bd/S{stroke}bd/F{fill}bd/q{gsave}bd" - "/Q{grestore}bd/s{scale}bd/t{concat}bd"); - mp_ps_print_nl(mp, "/sd{setdash}bd/rd{[] 0 setdash}bd/P{showpage}bd/B{q F Q}bd/W{clip}bd"); -} - - -@ The prologue defines \.{fshow} and corrects for the fact that \.{fshow} -arguments use |font_name| instead of |font_ps_name|. Downloaded bitmap fonts -might not have reasonable |font_ps_name| entries, but we just charge ahead -anyway. The user should not make \&{prologues} positive if this will cause -trouble. -@:prologues_}{\&{prologues} primitive@> - -@<Declarations@>= -static void mp_print_prologue (MP mp, mp_edge_object *h, int prologues, int procset); - -@ @c -void mp_print_prologue (MP mp, mp_edge_object *h, int prologues, int procset) { - font_number f; - font_number ldf ; - ldf = mp_print_font_comments (mp, h, prologues); - mp_ps_print_ln(mp); - if ( (prologues==1) && (mp->last_ps_fnum<mp->last_fnum) ) - mp_read_psname_table(mp); - mp_ps_print(mp, "%%BeginProlog"); mp_ps_print_ln(mp); - if ( (prologues>0)||(procset>0) ) { - if ( ldf!=null_font ) { - if ( prologues>0 ) { - for (f=null_font+1;f<=mp->last_fnum;f++) { - if ( mp_has_font_size(mp,f) ) { - mp_ps_name_out(mp, mp->font_name[f],true); - mp_ps_name_out(mp, mp->font_ps_name[f],true); - mp_ps_print(mp, " def"); - mp_ps_print_ln(mp); - } - } - if ( procset==0 ) { - mp_ps_print(mp, "/fshow {exch findfont exch scalefont setfont show}bind def"); - mp_ps_print_ln(mp); - } - } - } - if (procset>0 ) { - mp_ps_print_nl(mp, "%%BeginResource: procset mpost"); - if ( (prologues>0)&&(ldf!=null_font) ) - mp_ps_print_nl(mp, - "/bd{bind def}bind def/fshow {exch findfont exch scalefont setfont show}bd"); - else - mp_ps_print_nl(mp, "/bd{bind def}bind def"); - @<Print the procset@>; - mp_ps_print_nl(mp, "%%EndResource"); - mp_ps_print_ln(mp); - } - } - mp_ps_print(mp, "%%EndProlog"); - mp_ps_print_nl(mp, "%%Page: 1 1"); mp_ps_print_ln(mp); -} - -@ \MP\ used to have one single routine to print to both `write' files -and the PostScript output. Web2c redefines ``Character |k| cannot be -printed'', and that resulted in some bugs where 8-bit characters were -written to the PostScript file (reported by Wlodek Bzyl). - -Also, Hans Hagen requested spaces to be output as "\\040" instead of -a plain space, since that makes it easier to parse the result file -for postprocessing. - -@<Character |k| is not allowed in PostScript output@>= - (k<=' ')||(k>'~') - -@ We often need to print a pair of coordinates. - -@c -void mp_ps_pair_out (MP mp,scaled x, scaled y) { - ps_room(26); - mp_ps_print_scaled(mp, x); mp_ps_print_char(mp, ' '); - mp_ps_print_scaled(mp, y); mp_ps_print_char(mp, ' '); -} - -@ @<Declarations@>= -static void mp_ps_pair_out (MP mp,scaled x, scaled y) ; - -@ @c -void mp_ps_print_cmd (MP mp, const char *l, const char *s) { - if ( mp->internal[mp_procset]>0 ) { ps_room(strlen(s)); mp_ps_print(mp,s); } - else { ps_room(strlen(l)); mp_ps_print(mp, l); }; -} - -@ @<Declarations@>= -static void mp_ps_print_cmd (MP mp, const char *l, const char *s) ; - -@ @c -void mp_ps_string_out (MP mp, const char *s, size_t l) { - ASCII_code k; /* bits to be converted to octal */ - mp_ps_print(mp, "("); - while (l-->0) { - k=(ASCII_code)*s++; - if ( mp->ps->ps_offset+5>mp->max_print_line ) { - mp_ps_print_char(mp, '\\'); - mp_ps_print_ln(mp); - } - if ( (@<Character |k| is not allowed in PostScript output@>) ) { - mp_ps_print_char(mp, '\\'); - mp_ps_print_char(mp, '0'+(k / 64)); - mp_ps_print_char(mp, '0'+((k / 8) % 8)); - mp_ps_print_char(mp, '0'+(k % 8)); - } else { - if ( (k=='(')||(k==')')||(k=='\\') ) - mp_ps_print_char(mp, '\\'); - mp_ps_print_char(mp, k); - } - } - mp_ps_print_char(mp, ')'); -} - -@ @<Declarations@>= -static void mp_ps_string_out (MP mp, const char *s, size_t l) ; - -@ This is a define because the function does not use its |mp| argument. - -@d mp_is_ps_name(M,A) mp_do_is_ps_name(A) - -@c -static boolean mp_do_is_ps_name (char *s) { - ASCII_code k; /* the character being checked */ - while ((k=(ASCII_code)*s++)) { - if ( (k<=' ')||(k>'~') ) return false; - if ( (k=='(')||(k==')')||(k=='<')||(k=='>')|| - (k=='{')||(k=='}')||(k=='/')||(k=='%') ) return false; - } - return true; -} - -@ @<Declarations@>= -static void mp_ps_name_out (MP mp, char *s, boolean lit) ; - -@ @c -void mp_ps_name_out (MP mp, char *s, boolean lit) { - ps_room(strlen(s)+2); - mp_ps_print_char(mp, ' '); - if ( mp_is_ps_name(mp, s) ) { - if ( lit ) mp_ps_print_char(mp, '/'); - mp_ps_print(mp, s); - } else { - mp_ps_string_out(mp, s, strlen(s)); - if ( ! lit ) mp_ps_print(mp, "cvx "); - mp_ps_print(mp, "cvn"); - } -} - - -@ These special comments described in the {\sl PostScript Language Reference -Manual}, 2nd.~edition are understood by some \ps-reading programs. -We can't normally output ``conforming'' \ps\ because -the structuring conventions don't allow us to say ``Please make sure the -following characters are downloaded and define the \.{fshow} macro to access -them.'' - -The exact bounding box is written out if |mp_prologues<0|, although this -is not standard \ps, since it allows \TeX\ to calculate the box dimensions -accurately. (Overfull boxes are avoided if an illustration is made to -match a given \.{\char`\\hsize}.) - -@<Declarations@>= -static void mp_print_initial_comment(MP mp,mp_edge_object *hh, int prologues); - -@ @c -void mp_print_initial_comment(MP mp,mp_edge_object *hh, int prologues) { - scaled t; - char *s; - mp_ps_print(mp, "%!PS"); - if ( prologues>0 ) - mp_ps_print(mp, "-Adobe-3.0 EPSF-3.0"); - mp_ps_print_nl(mp, "%%BoundingBox: "); - if ( hh->minx>hh->maxx) { - mp_ps_print(mp, "0 0 0 0"); - } else if ( prologues<0 ) { - mp_ps_pair_out(mp, hh->minx,hh->miny); - mp_ps_pair_out(mp, hh->maxx,hh->maxy); - } else { - mp_ps_pair_out(mp, mp_floor_scaled(mp, hh->minx),mp_floor_scaled(mp, hh->miny)); - mp_ps_pair_out(mp, -mp_floor_scaled(mp, -hh->maxx),-mp_floor_scaled(mp, -hh->maxy)); - } - mp_ps_print_nl(mp, "%%HiResBoundingBox: "); - if ( hh->minx>hh->maxx ) { - mp_ps_print(mp, "0 0 0 0"); - } else { - mp_ps_pair_out(mp, hh->minx,hh->miny); - mp_ps_pair_out(mp, hh->maxx,hh->maxy); - } - mp_ps_print_nl(mp, "%%Creator: MetaPost "); - s = mp_metapost_version(); - mp_ps_print(mp, s); - mp_xfree(s); - mp_ps_print_nl(mp, "%%CreationDate: "); - mp_ps_print_int(mp, mp_round_unscaled(mp, mp->internal[mp_year])); - mp_ps_print_char(mp, '.'); - mp_ps_print_dd(mp, mp_round_unscaled(mp, mp->internal[mp_month])); - mp_ps_print_char(mp, '.'); - mp_ps_print_dd(mp, mp_round_unscaled(mp, mp->internal[mp_day])); - mp_ps_print_char(mp, ':'); - t=mp_round_unscaled(mp, mp->internal[mp_time]); - mp_ps_print_dd(mp, t / 60); - mp_ps_print_dd(mp, t % 60); - mp_ps_print_nl(mp, "%%Pages: 1"); -} - -@ The most important output procedure is the one that gives the \ps\ version of -a \MP\ path. - -@(mplibps.h@>= -typedef struct mp_knot { - unsigned short left_type; - unsigned short right_type; - signed int x_coord; - signed int y_coord; - signed int left_x; - signed int left_y; - signed int right_x; - signed int right_y; - struct mp_knot * next; - unsigned char originator; -} mp_knot; - -@ @<Types...@>= -#define gr_left_type(A) (A)->left_type -#define gr_right_type(A) (A)->right_type -#define gr_x_coord(A) (A)->x_coord -#define gr_y_coord(A) (A)->y_coord -#define gr_left_x(A) (A)->left_x -#define gr_left_y(A) (A)->left_y -#define gr_right_x(A) (A)->right_x -#define gr_right_y(A) (A)->right_y -#define gr_next_knot(A) (A)->next -#define gr_originator(A) (A)->originator - -@ If we want to duplicate a knot node, we can say |copy_knot|: - -@c -static mp_knot *mp_gr_copy_knot (MP mp, mp_knot *p) { - mp_knot *q; /* the copy */ - q = mp_xmalloc(mp, 1, sizeof (mp_knot)); - memcpy(q,p,sizeof (mp_knot)); - gr_next_knot(q)=NULL; - return q; -} - -@ The |copy_path| routine makes a clone of a given path. - -@c -static mp_knot *mp_gr_copy_path (MP mp, mp_knot *p) { - mp_knot *q, *pp, *qq; /* for list manipulation */ - if (p==NULL) - return NULL; - q=mp_gr_copy_knot(mp, p); - qq=q; - pp=gr_next_knot(p); - while ( pp!=p ) { - gr_next_knot(qq)=mp_gr_copy_knot(mp, pp); - qq=gr_next_knot(qq); - pp=gr_next_knot(pp); - } - gr_next_knot(qq)=q; - return q; -} - -@ Similarly, there's a way to copy the {\sl reverse\/} of a path. This procedure -returns a pointer to the first node of the copy, if the path is a cycle, -but to the final node of a non-cyclic copy. The global -variable |path_tail| will point to the final node of the original path; -this trick makes it easier to implement `\&{doublepath}'. - -All node types are assumed to be |endpoint| or |explicit| only. - -This function is currenly unused. - -@c -mp_knot * mp_gr_htap_ypoc (MP mp, mp_knot *p) { - mp_knot *q, *pp, *qq, *rr; /* for list manipulation */ - q=mp_xmalloc(mp, 1, sizeof (mp_knot)); /* this will correspond to |p| */ - qq=q; pp=p; - while (1) { - gr_right_type(qq)=gr_left_type(pp); - gr_left_type(qq)=gr_right_type(pp); - gr_x_coord(qq)=gr_x_coord(pp); - gr_y_coord(qq)=gr_y_coord(pp); - gr_right_x(qq)=gr_left_x(pp); - gr_right_y(qq)=gr_left_y(pp); - gr_left_x(qq)=gr_right_x(pp); - gr_left_y(qq)=gr_right_y(pp); - gr_originator(qq)=gr_originator(pp); - if ( gr_next_knot(pp)==p ) { - gr_next_knot(q)=qq; - /* |mp->path_tail=pp;| */ /* ? */ - return q; - } - rr=mp_xmalloc(mp, 1, sizeof (mp_knot)); - gr_next_knot(rr)=qq; - qq=rr; - pp=gr_next_knot(pp); - } -} - -@ When a cyclic list of knot nodes is no longer needed, it can be recycled by -calling the following subroutine. - -@<Declarations@>= -static void mp_do_gr_toss_knot_list (mp_knot *p) ; - -@ -@d mp_gr_toss_knot_list(B,A) mp_do_gr_toss_knot_list(A) - -@c -void mp_do_gr_toss_knot_list (mp_knot * p) { - mp_knot *q; /* the node being freed */ - mp_knot *r; /* the next node */ - if (p==NULL) - return; - q=p; - do { - r=gr_next_knot(q); - mp_xfree(q); q=r; - } while (q!=p); -} - - - -@ @c -static void mp_gr_ps_path_out (MP mp, mp_knot *h) { - mp_knot *p, *q; /* for scanning the path */ - scaled d; /* a temporary value */ - boolean curved; /* |true| unless the cubic is almost straight */ - ps_room(40); - mp_ps_print_cmd(mp, "newpath ","n "); - mp_ps_pair_out(mp, gr_x_coord(h),gr_y_coord(h)); - mp_ps_print_cmd(mp, "moveto","m"); - p=h; - do { - if ( gr_right_type(p)==mp_endpoint ) { - if ( p==h ) mp_ps_print_cmd(mp, " 0 0 rlineto"," 0 0 r"); - return; - } - q=gr_next_knot(p); - @<Start a new line and print the \ps\ commands for the curve from - |p| to~|q|@>; - p=q; - } while (p!=h); - mp_ps_print_cmd(mp, " closepath"," p"); -} - -@ @<Start a new line and print the \ps\ commands for the curve from...@>= -curved=true; -@<Set |curved:=false| if the cubic from |p| to |q| is almost straight@>; -mp_ps_print_ln(mp); -if ( curved ){ - mp_ps_pair_out(mp, gr_right_x(p),gr_right_y(p)); - mp_ps_pair_out(mp, gr_left_x(q),gr_left_y(q)); - mp_ps_pair_out(mp, gr_x_coord(q),gr_y_coord(q)); - mp_ps_print_cmd(mp, "curveto","c"); -} else if ( q!=h ){ - mp_ps_pair_out(mp, gr_x_coord(q),gr_y_coord(q)); - mp_ps_print_cmd(mp, "lineto","l"); -} - -@ Two types of straight lines come up often in \MP\ paths: -cubics with zero initial and final velocity as created by |make_path| or -|make_envelope|, and cubics with control points uniformly spaced on a line -as created by |make_choices|. - -@d bend_tolerance 131 /* allow rounding error of $2\cdot10^{-3}$ */ - -@<Set |curved:=false| if the cubic from |p| to |q| is almost straight@>= -if ( gr_right_x(p)==gr_x_coord(p) ) - if ( gr_right_y(p)==gr_y_coord(p) ) - if ( gr_left_x(q)==gr_x_coord(q) ) - if ( gr_left_y(q)==gr_y_coord(q) ) curved=false; -d=gr_left_x(q)-gr_right_x(p); -if ( abs(gr_right_x(p)-gr_x_coord(p)-d)<=bend_tolerance ) - if ( abs(gr_x_coord(q)-gr_left_x(q)-d)<=bend_tolerance ) - { d=gr_left_y(q)-gr_right_y(p); - if ( abs(gr_right_y(p)-gr_y_coord(p)-d)<=bend_tolerance ) - if ( abs(gr_y_coord(q)-gr_left_y(q)-d)<=bend_tolerance ) curved=false; - } - -@ The colored objects use a struct with anonymous fields to express the color parts: - -@(mplibps.h@>= -typedef struct { - int a_val, b_val, c_val, d_val; -} mp_color; - -@ The exported form of a dash pattern is simpler than the internal -format, it is closely modelled to the PostScript model. The array of -dashes is ended by a single negative value, because this is not -allowed in PostScript. - -@(mplibps.h@>= -typedef struct { - int offset; - int *array; -} mp_dash_object ; - - -@ -@d mp_gr_toss_dashes(A,B) mp_do_gr_toss_dashes(B) - -@<Declarations@>= -static void mp_do_gr_toss_dashes(mp_dash_object *dl); - -@ @c -void mp_do_gr_toss_dashes(mp_dash_object *dl) { - if (dl==NULL) - return; - mp_xfree(dl->array); - mp_xfree(dl); -} - - -@ @c -static mp_dash_object *mp_gr_copy_dashes(MP mp, mp_dash_object *dl) { - mp_dash_object *q = NULL; - (void)mp; - if (dl==NULL) - return NULL; - q = mp_xmalloc(mp, 1, sizeof (mp_dash_object)); - memcpy (q,dl,sizeof(mp_dash_object)); - if (dl->array != NULL) { - size_t i = 0; - while (*(dl->array+i) != -1) i++; - q->array = mp_xmalloc(mp, i, sizeof (scaled)); - memcpy(q->array,dl->array, (i*sizeof(scaled))); - } - return q; -} - - -@ Now for outputting the actual graphic objects. First, set up some -structures and access macros. - -@d gr_has_color(A) (gr_type((A))<mp_start_clip_code) - -@<Types...@>= -#define gr_type(A) (A)->type -#define gr_link(A) (A)->next -#define gr_color_model(A) (A)->color_model -#define gr_red_val(A) (A)->color.a_val -#define gr_green_val(A) (A)->color.b_val -#define gr_blue_val(A) (A)->color.c_val -#define gr_cyan_val(A) (A)->color.a_val -#define gr_magenta_val(A) (A)->color.b_val -#define gr_yellow_val(A) (A)->color.c_val -#define gr_black_val(A) (A)->color.d_val -#define gr_grey_val(A) (A)->color.a_val -#define gr_path_p(A) (A)->path_p -#define gr_htap_p(A) ((mp_fill_object *)A)->htap_p -#define gr_pen_p(A) (A)->pen_p -#define gr_ljoin_val(A) (A)->ljoin -#define gr_lcap_val(A) ((mp_stroked_object *)A)->lcap -#define gr_miterlim_val(A) (A)->miterlim -#define gr_pre_script(A) (A)->pre_script -#define gr_post_script(A) (A)->post_script -#define gr_dash_p(A) ((mp_stroked_object *)A)->dash_p -#define gr_size_index(A) ((mp_text_object *)A)->size_index -#define gr_text_p(A) ((mp_text_object *)A)->text_p -#define gr_text_l(A) ((mp_text_object *)A)->text_l -#define gr_font_n(A) ((mp_text_object *)A)->font_n -#define gr_font_name(A) ((mp_text_object *)A)->font_name -#define gr_font_dsize(A) ((mp_text_object *)A)->font_dsize -#define gr_width_val(A) ((mp_text_object *)A)->width -#define gr_height_val(A) ((mp_text_object *)A)->height -#define gr_depth_val(A) ((mp_text_object *)A)->depth -#define gr_tx_val(A) ((mp_text_object *)A)->tx -#define gr_ty_val(A) ((mp_text_object *)A)->ty -#define gr_txx_val(A) ((mp_text_object *)A)->txx -#define gr_txy_val(A) ((mp_text_object *)A)->txy -#define gr_tyx_val(A) ((mp_text_object *)A)->tyx -#define gr_tyy_val(A) ((mp_text_object *)A)->tyy - -@ @(mplibps.h@>= -#define GRAPHIC_BODY \ - int type; \ - struct mp_graphic_object * next - -typedef struct mp_graphic_object { - GRAPHIC_BODY; -} mp_graphic_object; - -typedef struct mp_text_object { - GRAPHIC_BODY; - char *pre_script; - char *post_script; - mp_color color; - unsigned char color_model; - unsigned char size_index; - char *text_p; - size_t text_l; - char *font_name ; - unsigned int font_dsize ; - unsigned int font_n ; - int width ; - int height ; - int depth ; - int tx ; - int ty ; - int txx ; - int txy ; - int tyx ; - int tyy ; -} mp_text_object; - -typedef struct mp_fill_object { - GRAPHIC_BODY; - char *pre_script; - char *post_script; - mp_color color; - unsigned char color_model; - unsigned char ljoin ; - mp_knot * path_p; - mp_knot * htap_p; - mp_knot * pen_p; - int miterlim ; -} mp_fill_object; - -typedef struct mp_stroked_object { - GRAPHIC_BODY; - char *pre_script; - char *post_script; - mp_color color; - unsigned char color_model; - unsigned char ljoin ; - unsigned char lcap ; - mp_knot * path_p; - mp_knot * pen_p; - int miterlim ; - mp_dash_object *dash_p; -} mp_stroked_object; - -typedef struct mp_clip_object { - GRAPHIC_BODY; - mp_knot * path_p; -} mp_clip_object; - -typedef struct mp_bounds_object { - GRAPHIC_BODY; - mp_knot * path_p; -} mp_bounds_object; - -typedef struct mp_special_object { - GRAPHIC_BODY; - char *pre_script; -} mp_special_object ; - -typedef struct mp_edge_object { - struct mp_graphic_object * body; - struct mp_edge_object * next; - char * filename; - MP parent; - int minx, miny, maxx, maxy; - int width, height, depth, ital_corr; - int charcode; -} mp_edge_object; - -@ @<Exported function headers@>= -mp_graphic_object *mp_new_graphic_object(MP mp, int type); - -@ @c -mp_graphic_object *mp_new_graphic_object (MP mp, int type) { - mp_graphic_object *p; - size_t size ; - switch (type) { - case mp_fill_code: size = sizeof(mp_fill_object); break; - case mp_stroked_code: size = sizeof(mp_stroked_object); break; - case mp_text_code: size = sizeof(mp_text_object); break; - case mp_start_clip_code: size = sizeof(mp_clip_object); break; - case mp_start_bounds_code: size = sizeof(mp_bounds_object); break; - case mp_special_code: size = sizeof(mp_special_object); break; - default: size = sizeof(mp_graphic_object); break; - } - p = (mp_graphic_object *)mp_xmalloc(mp,1,size); - memset(p,0,size); - gr_type(p) = type; - return p; -} - -@ We need to keep track of several parameters from the \ps\ graphics state. -@^graphics state@> -This allows us to be sure that \ps\ has the correct values when they are -needed without wasting time and space setting them unnecessarily. - -@d gs_red mp->ps->gs_state->red_field -@d gs_green mp->ps->gs_state->green_field -@d gs_blue mp->ps->gs_state->blue_field -@d gs_black mp->ps->gs_state->black_field -@d gs_colormodel mp->ps->gs_state->colormodel_field -@d gs_ljoin mp->ps->gs_state->ljoin_field -@d gs_lcap mp->ps->gs_state->lcap_field -@d gs_adj_wx mp->ps->gs_state->adj_wx_field -@d gs_miterlim mp->ps->gs_state->miterlim_field -@d gs_dash_p mp->ps->gs_state->dash_p_field -@d gs_dash_init_done mp->ps->gs_state->dash_done_field -@d gs_previous mp->ps->gs_state->previous_field -@d gs_width mp->ps->gs_state->width_field - -@<Types...@>= -typedef struct _gs_state { - scaled red_field ; - scaled green_field ; - scaled blue_field ; - scaled black_field ; - /* color from the last \&{setcmykcolor} or \&{setrgbcolor} or \&{setgray} command */ - quarterword colormodel_field ; - /* the current colormodel */ - quarterword ljoin_field ; - quarterword lcap_field ; - /* values from the last \&{setlinejoin} and \&{setlinecap} commands */ - quarterword adj_wx_field ; - /* what resolution-dependent adjustment applies to the width */ - scaled miterlim_field ; - /* the value from the last \&{setmiterlimit} command */ - mp_dash_object * dash_p_field ; - /* edge structure for last \&{setdash} command */ - boolean dash_done_field ; /* to test for initial \&{setdash} */ - struct _gs_state * previous_field ; - /* backlink to the previous |_gs_state| structure */ - scaled width_field ; - /* width setting or $-1$ if no \&{setlinewidth} command so far */ -} _gs_state; - - -@ @<Glob...@>= -struct _gs_state * gs_state; - -@ @<Set init...@>= -mp->ps->gs_state=NULL; - -@ @<Dealloc variables@>= -mp_xfree(mp->ps->gs_state); - -@ To avoid making undue assumptions about the initial graphics state, these -parameters are given special values that are guaranteed not to match anything -in the edge structure being shipped out. On the other hand, the initial color -should be black so that the translation of an all-black picture will have no -\&{setcolor} commands. (These would be undesirable in a font application.) -Hence we use |c=0| when initializing the graphics state and we use |c<0| -to recover from a situation where we have lost track of the graphics state. - -@d mp_void (null+1) /* a null pointer different from |null| */ - -@c static void mp_gs_unknown_graphics_state (MP mp,scaled c) { - struct _gs_state *p; /* to shift graphic states around */ - if ( (c==0)||(c==-1) ) { - if ( mp->ps->gs_state==NULL ) { - mp->ps->gs_state = mp_xmalloc(mp,1,sizeof(struct _gs_state)); - gs_previous=NULL; - } else { - while ( gs_previous!=NULL ) { - p = gs_previous; - mp_xfree(mp->ps->gs_state); - mp->ps->gs_state=p; - } - } - gs_red=c; gs_green=c; gs_blue=c; gs_black=c; - gs_colormodel=mp_uninitialized_model; - gs_ljoin=3; - gs_lcap=3; - gs_miterlim=0; - gs_dash_p=NULL; - gs_dash_init_done=false; - gs_width=-1; - } else if ( c==1 ) { - p= mp->ps->gs_state; - mp->ps->gs_state = mp_xmalloc(mp,1,sizeof(struct _gs_state)); - memcpy(mp->ps->gs_state,p,sizeof(struct _gs_state)); - gs_previous = p; - } else if ( c==2 ) { - p = gs_previous; - mp_xfree(mp->ps->gs_state); - mp->ps->gs_state=p; - } -} - - -@ When it is time to output a graphical object, |fix_graphics_state| ensures -that \ps's idea of the graphics state agrees with what is stored in the object. - -@<Declarations@>= -static void mp_gr_fix_graphics_state (MP mp, mp_graphic_object *p) ; - -@ @c -void mp_gr_fix_graphics_state (MP mp, mp_graphic_object *p) { - /* get ready to output graphical object |p| */ - mp_knot *pp, *path_p; /* for list manipulation */ - mp_dash_object *hh; - scaled wx,wy,ww; /* dimensions of pen bounding box */ - quarterword adj_wx; /* whether pixel rounding should be based on |wx| or |wy| */ - integer tx,ty; /* temporaries for computing |adj_wx| */ - if ( gr_has_color(p) ) - @<Make sure \ps\ will use the right color for object~|p|@>; - if ( (gr_type(p)==mp_fill_code)||(gr_type(p)==mp_stroked_code) ) { - if (gr_type(p)==mp_fill_code) { - pp = gr_pen_p((mp_fill_object *)p); - path_p = gr_path_p((mp_fill_object *)p); - } else { - pp = gr_pen_p((mp_stroked_object *)p); - path_p = gr_path_p((mp_stroked_object *)p); - } - if ( pp!=NULL ) - if ( pen_is_elliptical(pp) ) { - @<Generate \ps\ code that sets the stroke width to the - appropriate rounded value@>; - @<Make sure \ps\ will use the right dash pattern for |dash_p(p)|@>; - @<Decide whether the line cap parameter matters and set it if necessary@>; - @<Set the other numeric parameters as needed for object~|p|@>; - } - } - if ( mp->ps->ps_offset>0 ) mp_ps_print_ln(mp); -} - -@ @<Decide whether the line cap parameter matters and set it if necessary@>= -if ( gr_type(p)==mp_stroked_code ) { - mp_stroked_object *ts = (mp_stroked_object *)p; - if ( (gr_left_type(gr_path_p(ts))==mp_endpoint)||(gr_dash_p(ts)!=NULL) ) - if ( gs_lcap!=(quarterword)gr_lcap_val(ts) ) { - ps_room(13); - mp_ps_print_char(mp, ' '); - mp_ps_print_char(mp, '0'+gr_lcap_val(ts)); - mp_ps_print_cmd(mp, " setlinecap"," lc"); - gs_lcap=(quarterword)gr_lcap_val(ts); - } -} - -@ -@d set_ljoin_miterlim(p) - if ( gs_ljoin!=(quarterword)gr_ljoin_val(p) ) { - ps_room(14); - mp_ps_print_char(mp, ' '); - mp_ps_print_char(mp, '0'+gr_ljoin_val(p)); - mp_ps_print_cmd(mp, " setlinejoin"," lj"); - gs_ljoin=(quarterword)gr_ljoin_val(p); - } - if ( gs_miterlim!=gr_miterlim_val(p) ) { - ps_room(27); - mp_ps_print_char(mp, ' '); - mp_ps_print_scaled(mp, gr_miterlim_val(p)); - mp_ps_print_cmd(mp, " setmiterlimit"," ml"); - gs_miterlim=gr_miterlim_val(p); - } - -@<Set the other numeric parameters as needed for object~|p|@>= -if ( gr_type(p)==mp_stroked_code ) { - mp_stroked_object *ts = (mp_stroked_object *)p; - set_ljoin_miterlim(ts); -} else { - mp_fill_object *ts = (mp_fill_object *)p; - set_ljoin_miterlim(ts); -} - -@ -@d set_color_objects(pq) - object_color_model = pq->color_model; - object_color_a = pq->color.a_val; - object_color_b = pq->color.b_val; - object_color_c = pq->color.c_val; - object_color_d = pq->color.d_val; - -@<Make sure \ps\ will use the right color for object~|p|@>= -{ - int object_color_model; - int object_color_a, object_color_b, object_color_c, object_color_d ; - if (gr_type(p) == mp_fill_code) { - mp_fill_object *pq = (mp_fill_object *)p; - set_color_objects(pq); - } else if (gr_type(p) == mp_stroked_code) { - mp_stroked_object *pq = (mp_stroked_object *)p; - set_color_objects(pq); - } else { - mp_text_object *pq = (mp_text_object *)p; - set_color_objects(pq); - } - - if ( object_color_model==mp_rgb_model) { - if ( (gs_colormodel!=mp_rgb_model)||(gs_red!=object_color_a)|| - (gs_green!=object_color_b)||(gs_blue!=object_color_c) ) { - gs_red = object_color_a; - gs_green = object_color_b; - gs_blue = object_color_c; - gs_black = -1; - gs_colormodel=mp_rgb_model; - { ps_room(36); - mp_ps_print_char(mp, ' '); - mp_ps_print_scaled(mp, gs_red); mp_ps_print_char(mp, ' '); - mp_ps_print_scaled(mp, gs_green); mp_ps_print_char(mp, ' '); - mp_ps_print_scaled(mp, gs_blue); - mp_ps_print_cmd(mp, " setrgbcolor", " R"); - } - } - } else if ( object_color_model==mp_cmyk_model) { - if ( (gs_red!=object_color_a)||(gs_green!=object_color_b)|| - (gs_blue!=object_color_c)||(gs_black!=object_color_d)|| - (gs_colormodel!=mp_cmyk_model) ) { - gs_red = object_color_a; - gs_green = object_color_b; - gs_blue = object_color_c; - gs_black = object_color_d; - gs_colormodel=mp_cmyk_model; - { ps_room(45); - mp_ps_print_char(mp, ' '); - mp_ps_print_scaled(mp, gs_red); - mp_ps_print_char(mp, ' '); - mp_ps_print_scaled(mp, gs_green); - mp_ps_print_char(mp, ' '); - mp_ps_print_scaled(mp, gs_blue); - mp_ps_print_char(mp, ' '); - mp_ps_print_scaled(mp, gs_black); - mp_ps_print_cmd(mp, " setcmykcolor"," C"); - } - } - } else if ( object_color_model==mp_grey_model ) { - if ( (gs_red!=object_color_a)||(gs_colormodel!=mp_grey_model) ) { - gs_red = object_color_a; - gs_green = -1; - gs_blue = -1; - gs_black = -1; - gs_colormodel=mp_grey_model; - { ps_room(16); - mp_ps_print_char(mp, ' '); - mp_ps_print_scaled(mp, gs_red); - mp_ps_print_cmd(mp, " setgray"," G"); - } - } - } else if ( object_color_model==mp_no_model ) { - gs_colormodel=mp_no_model; - } -} - -@ In order to get consistent widths for horizontal and vertical pen strokes, we -want \ps\ to use an integer number of pixels for the \&{setwidth} parameter. -@:setwidth}{\&{setwidth}command@> -We set |gs_width| to the ideal horizontal or vertical stroke width and then -generate \ps\ code that computes the rounded value. For non-circular pens, the -pen shape will be rescaled so that horizontal or vertical parts of the stroke -have the computed width. - -Rounding the width to whole pixels is not likely to improve the appearance of -diagonal or curved strokes, but we do it anyway for consistency. The -\&{truncate} command generated here tends to make all the strokes a little -@:truncate}{\&{truncate} command@> -thinner, but this is appropriate for \ps's scan-conversion rules. Even with -truncation, an ideal with of $w$~pixels gets mapped into $\lfloor w\rfloor+1$. -It would be better to have $\lceil w\rceil$ but that is ridiculously expensive -to compute in \ps. - -@<Generate \ps\ code that sets the stroke width...@>= -@<Set |wx| and |wy| to the width and height of the bounding box for - |pen_p(p)|@>; -@<Use |pen_p(p)| and |path_p(p)| to decide whether |wx| or |wy| is more - important and set |adj_wx| and |ww| accordingly@>; -if ( (ww!=gs_width) || (adj_wx!=gs_adj_wx) ) { - if ( adj_wx != 0 ) { - ps_room(13); - mp_ps_print_char(mp, ' '); mp_ps_print_scaled(mp, ww); - mp_ps_print_cmd(mp, - " 0 dtransform exch truncate exch idtransform pop setlinewidth"," hlw"); - } else { - if ( mp->internal[mp_procset]>0 ) { - ps_room(13); - mp_ps_print_char(mp, ' '); - mp_ps_print_scaled(mp, ww); - mp_ps_print(mp, " vlw"); - } else { - ps_room(15); - mp_ps_print(mp, " 0 "); mp_ps_print_scaled(mp, ww); - mp_ps_print(mp, " dtransform truncate idtransform setlinewidth pop"); - } - } - gs_width = ww; - gs_adj_wx = adj_wx; -} - -@ @<Set |wx| and |wy| to the width and height of the bounding box for...@>= -if ( (gr_right_x(pp)==gr_x_coord(pp)) && (gr_left_y(pp)==gr_y_coord(pp)) ) { - wx = abs(gr_left_x(pp) - gr_x_coord(pp)); - wy = abs(gr_right_y(pp) - gr_y_coord(pp)); -} else { - wx = mp_pyth_add(mp, gr_left_x(pp)-gr_x_coord(pp), gr_right_x(pp)-gr_x_coord(pp)); - wy = mp_pyth_add(mp, gr_left_y(pp)-gr_y_coord(pp), gr_right_y(pp)-gr_y_coord(pp)); -} - -@ The path is considered ``essentially horizontal'' if its range of -$y$~coordinates is less than the $y$~range |wy| for the pen. ``Essentially -vertical'' paths are detected similarly. This code ensures that no component -of the pen transformation is more that |aspect_bound*(ww+1)|. - -@d aspect_bound 10 /* ``less important'' of |wx|, |wy| cannot exceed the other by - more than this factor */ - -@d do_x_loc 1 -@d do_y_loc 2 - -@<Use |pen_p(p)| and |path_p(p)| to decide whether |wx| or |wy| is more...@>= -tx=1; ty=1; -if ( mp_gr_coord_rangeOK(path_p, do_y_loc, wy) ) tx=aspect_bound; -else if ( mp_gr_coord_rangeOK(path_p, do_x_loc, wx) ) ty=aspect_bound; -if ( wy / ty>=wx / tx ) { ww=wy; adj_wx=0; } -else { ww=wx; adj_wx=1; } - -@ This routine quickly tests if path |h| is ``essentially horizontal'' or -``essentially vertical,'' where |zoff| is |x_loc(0)| or |y_loc(0)| and |dz| is -allowable range for $x$ or~$y$. We do not need and cannot afford a full -bounding-box computation. - -@<Declarations@>= -static boolean mp_gr_coord_rangeOK (mp_knot *h, - quarterword zoff, scaled dz); - -@ @c -boolean mp_gr_coord_rangeOK (mp_knot *h, - quarterword zoff, scaled dz) { - mp_knot *p; /* for scanning the path form |h| */ - scaled zlo,zhi; /* coordinate range so far */ - scaled z; /* coordinate currently being tested */ - if (zoff==do_x_loc) { - zlo=gr_x_coord(h); - zhi=zlo; - p=h; - while ( gr_right_type(p)!=mp_endpoint ) { - z=gr_right_x(p); - @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>; - p=gr_next_knot(p); z=gr_left_x(p); - @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>; - z=gr_x_coord(p); - @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>; - if ( p==h ) break; - } - } else { - zlo=gr_y_coord(h); - zhi=zlo; - p=h; - while ( gr_right_type(p)!=mp_endpoint ) { - z=gr_right_y(p); - @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>; - p=gr_next_knot(p); z=gr_left_y(p); - @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>; - z=gr_y_coord(p); - @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>; - if ( p==h ) break; - } - } - return true; -} - -@ @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>= -if ( z<zlo ) zlo=z; -else if ( z>zhi ) zhi=z; -if ( zhi-zlo>dz ) return false - -@ Filling with an elliptical pen is implemented via a combination of \&{stroke} -and \&{fill} commands and a nontrivial dash pattern would interfere with this. -@:stroke}{\&{stroke} command@> -@:fill}{\&{fill} command@> -Note that we don't use |delete_edge_ref| because |gs_dash_p| is not counted as -a reference. - -@<Make sure \ps\ will use the right dash pattern for |dash_p(p)|@>= -if ( gr_type(p)==mp_fill_code || gr_dash_p(p) == NULL) { - hh=NULL; -} else { - hh=gr_dash_p(p); -} -if ( hh==NULL ) { - if ( gs_dash_p!=NULL || gs_dash_init_done == false) { - mp_ps_print_cmd(mp, " [] 0 setdash"," rd"); - gs_dash_p=NULL; - gs_dash_init_done=true; - } -} else if ( ! mp_gr_same_dashes(gs_dash_p,hh) ) { - @<Set the dash pattern from |dash_list(hh)| scaled by |scf|@>; -} - -@ The original code had a check here to ensure that the result from -|mp_take_scaled| did not go out of bounds. - -@<Set the dash pattern from |dash_list(hh)| scaled by |scf|@>= -{ gs_dash_p=hh; - if ( (gr_dash_p(p)==NULL) || (hh==NULL) || (hh->array==NULL)) { - mp_ps_print_cmd(mp, " [] 0 setdash"," rd"); - } else { - int i; - ps_room(28); - mp_ps_print(mp, " ["); - for (i=0; *(hh->array+i) != -1;i++) { - ps_room(13); - mp_ps_print_scaled(mp, *(hh->array+i)); - mp_ps_print_char(mp, ' ') ; - } - ps_room(22); - mp_ps_print(mp, "] "); - mp_ps_print_scaled(mp, hh->offset); - mp_ps_print_cmd(mp, " setdash"," sd"); - } -} - -@ @<Declarations@>= -static boolean mp_gr_same_dashes (mp_dash_object *h, mp_dash_object *hh) ; - -@ This function test if |h| and |hh| represent the same dash pattern. - -@c -boolean mp_gr_same_dashes (mp_dash_object *h, mp_dash_object *hh) { - boolean ret=false; - int i = 0; - if ( h==hh ) ret=true; - else if ( (h==NULL)||(hh==NULL) ) ret=false; - else if ( h->offset!=hh->offset ) ret=false; - else if ( h->array == hh->array ) ret=true; - else if ( h->array == NULL || hh->array == NULL) ret=false; - else { @<Compare |dash_list(h)| and |dash_list(hh)|@>; } - return ret; -} - -@ @<Compare |dash_list(h)| and |dash_list(hh)|@>= -{ - while (*(h->array+i)!=-1 && - *(hh->array+i)!=-1 && - *(h->array+i) == *(hh->array+i)) i++; - if (i>0) { - if (*(h->array+i)==-1 && *(hh->array+i) == -1) - ret=true; - } -} - -@ When stroking a path with an elliptical pen, it is necessary to transform -the coordinate system so that a unit circular pen will have the desired shape. -To keep this transformation local, we enclose it in a -$$\&{gsave}\ldots\&{grestore}$$ -block. Any translation component must be applied to the path being stroked -while the rest of the transformation must apply only to the pen. -If |fill_also=true|, the path is to be filled as well as stroked so we must -insert commands to do this after giving the path. - -@<Declarations@>= -static void mp_gr_stroke_ellipse (MP mp, mp_graphic_object *h, boolean fill_also) ; - -@ -@c void mp_gr_stroke_ellipse (MP mp, mp_graphic_object *h, boolean fill_also) { - /* generate an elliptical pen stroke from object |h| */ - scaled txx,txy,tyx,tyy; /* transformation parameters */ - mp_knot *p; /* the pen to stroke with */ - scaled d1,det; /* for tweaking transformation parameters */ - integer s; /* also for tweaking transformation paramters */ - boolean transformed; /* keeps track of whether gsave/grestore are needed */ - transformed=false; - @<Use |pen_p(h)| to set the transformation parameters and give the initial - translation@>; - @<Tweak the transformation parameters so the transformation is nonsingular@>; - if (gr_type(h)==mp_fill_code) { - mp_gr_ps_path_out(mp, gr_path_p((mp_fill_object *)h)); - } else { - mp_gr_ps_path_out(mp, gr_path_p((mp_stroked_object *)h)); - } - if ( mp->internal[mp_procset]==0 ) { - if ( fill_also ) mp_ps_print_nl(mp, "gsave fill grestore"); - @<Issue \ps\ commands to transform the coordinate system@>; - mp_ps_print(mp, " stroke"); - if ( transformed ) mp_ps_print(mp, " grestore"); - } else { - if ( fill_also ) mp_ps_print_nl(mp, "B"); else mp_ps_print_ln(mp); - if ( (txy!=0)||(tyx!=0) ) { - mp_ps_print(mp, " ["); - mp_ps_pair_out(mp, txx,tyx); - mp_ps_pair_out(mp, txy,tyy); - mp_ps_print(mp, "0 0] t"); - } else if ((txx!=unity)||(tyy!=unity) ) { - mp_ps_pair_out(mp,txx,tyy); - mp_ps_print(mp, " s"); - }; - mp_ps_print(mp, " S"); - if ( transformed ) mp_ps_print(mp, " Q"); - } - mp_ps_print_ln(mp); -} - -@ @<Use |pen_p(h)| to set the transformation parameters and give the...@>= -if (gr_type(h)==mp_fill_code) { - p=gr_pen_p((mp_fill_object *)h); -} else { - p=gr_pen_p((mp_stroked_object *)h); -} -txx=gr_left_x(p); -tyx=gr_left_y(p); -txy=gr_right_x(p); -tyy=gr_right_y(p); -if ( (gr_x_coord(p)!=0)||(gr_y_coord(p)!=0) ) { - mp_ps_print_nl(mp, ""); - mp_ps_print_cmd(mp, "gsave ","q "); - mp_ps_pair_out(mp, gr_x_coord(p), gr_y_coord(p)); - mp_ps_print(mp, "translate "); - txx-=gr_x_coord(p); - tyx-=gr_y_coord(p); - txy-=gr_x_coord(p); - tyy-=gr_y_coord(p); - transformed=true; -} else { - mp_ps_print_nl(mp, ""); -} -@<Adjust the transformation to account for |gs_width| and output the - initial \&{gsave} if |transformed| should be |true|@> - -@ @<Adjust the transformation to account for |gs_width| and output the...@>= -if ( gs_width!=unity ) { - if ( gs_width==0 ) { - txx=unity; tyy=unity; - } else { - txx=mp_make_scaled(mp, txx,gs_width); - txy=mp_make_scaled(mp, txy,gs_width); - tyx=mp_make_scaled(mp, tyx,gs_width); - tyy=mp_make_scaled(mp, tyy,gs_width); - }; -} -if ( (txy!=0)||(tyx!=0)||(txx!=unity)||(tyy!=unity) ) { - if ( (! transformed) ){ - mp_ps_print_cmd(mp, "gsave ","q "); - transformed=true; - } -} - -@ @<Issue \ps\ commands to transform the coordinate system@>= -if ( (txy!=0)||(tyx!=0) ){ - mp_ps_print_ln(mp); - mp_ps_print_char(mp, '['); - mp_ps_pair_out(mp, txx,tyx); - mp_ps_pair_out(mp, txy,tyy); - mp_ps_print(mp, "0 0] concat"); -} else if ( (txx!=unity)||(tyy!=unity) ){ - mp_ps_print_ln(mp); - mp_ps_pair_out(mp, txx,tyy); - mp_ps_print(mp, "scale"); -} - -@ The \ps\ interpreter will probably abort if it encounters a singular -transformation matrix. The determinant must be large enough to ensure that -the printed representation will be nonsingular. Since the printed -representation is always within $2^{-17}$ of the internal |scaled| value, the -total error is at most $4T_{\rm max}2^{-17}$, where $T_{\rm max}$ is a bound on -the magnitudes of |txx/65536|, |txy/65536|, etc. - -The |aspect_bound*(gs_width+1)| bound on the components of the pen -transformation allows $T_{\rm max}$ to be at most |2*aspect_bound|. - -@<Tweak the transformation parameters so the transformation is nonsingular@>= -det=mp_take_scaled(mp, txx,tyy) - mp_take_scaled(mp, txy,tyx); -d1=4*aspect_bound+1; -if ( abs(det)<d1 ) { - if ( det>=0 ) { d1=d1-det; s=1; } - else { d1=-d1-det; s=-1; }; - d1=d1*unity; - if ( abs(txx)+abs(tyy)>=abs(txy)+abs(tyy) ) { - if ( abs(txx)>abs(tyy) ) tyy=tyy+(d1+s*abs(txx)) / txx; - else txx=txx+(d1+s*abs(tyy)) / tyy; - } else { - if ( abs(txy)>abs(tyx) ) tyx=tyx+(d1+s*abs(txy)) / txy; - else txy=txy+(d1+s*abs(tyx)) / tyx; - } -} - -@ Here is a simple routine that just fills a cycle. - -@<Declarations@>= -static void mp_gr_ps_fill_out (MP mp, mp_knot *p); - -@ @c -void mp_gr_ps_fill_out (MP mp, mp_knot *p) { /* fill cyclic path~|p| */ - mp_gr_ps_path_out(mp, p); - mp_ps_print_cmd(mp, " fill"," F"); - mp_ps_print_ln(mp); -} - -@ A text node may specify an arbitrary transformation but the usual case -involves only shifting, scaling, and occasionally rotation. The purpose -of |choose_scale| is to select a scale factor so that the remaining -transformation is as ``nice'' as possible. The definition of ``nice'' -is somewhat arbitrary but shifting and $90^\circ$ rotation are especially -nice because they work out well for bitmap fonts. The code here selects -a scale factor equal to $1/\sqrt2$ times the Frobenius norm of the -non-shifting part of the transformation matrix. It is careful to avoid -additions that might cause undetected overflow. - -@<Declarations@>= -static scaled mp_gr_choose_scale (MP mp, mp_graphic_object *p) ; - -@ @c scaled mp_gr_choose_scale (MP mp, mp_graphic_object *p) { - /* |p| should point to a text node */ - scaled a,b,c,d,ad,bc; /* temporary values */ - a=gr_txx_val(p); - b=gr_txy_val(p); - c=gr_tyx_val(p); - d=gr_tyy_val(p); - if ( a<0 ) negate(a); - if ( b<0 ) negate(b); - if ( c<0 ) negate(c); - if ( d<0 ) negate(d); - ad=half(a-d); - bc=half(b-c); - return mp_pyth_add(mp, mp_pyth_add(mp, d+ad,ad), mp_pyth_add(mp, c+bc,bc)); -} - -@ The potential overflow here is caused by the fact the returned value -has to fit in a |name_type|, which is a quarterword. - -@d fscale_tolerance 65 /* that's $.001\times2^{16}$ */ - -@<Declarations@>= -static quarterword mp_size_index (MP mp, font_number f, scaled s) ; - -@ @c -quarterword mp_size_index (MP mp, font_number f, scaled s) { - pointer p,q; /* the previous and current font size nodes */ - quarterword i; /* the size index for |q| */ - q=mp->font_sizes[f]; - i=0; - while ( q!=null ) { - if ( abs(s-sc_factor(q))<=fscale_tolerance ) - return i; - else - { p=q; q=link(q); incr(i); }; - if ( i==max_quarterword ) - mp_overflow(mp, "sizes per font",max_quarterword); -@:MetaPost capacity exceeded sizes per font}{\quad sizes per font@> - } - q=mp_get_node(mp, font_size_size); - sc_factor(q)=s; - if ( i==0 ) mp->font_sizes[f]=q; else link(p)=q; - return i; -} - -@ @<Declarations@>= -static scaled mp_indexed_size (MP mp,font_number f, quarterword j); - -@ @c -scaled mp_indexed_size (MP mp,font_number f, quarterword j) { - pointer p; /* a font size node */ - quarterword i; /* the size index for |p| */ - p=mp->font_sizes[f]; - i=0; - if ( p==null ) mp_confusion(mp, "size"); - while ( (i!=j) ) { - incr(i); p=link(p); - if ( p==null ) mp_confusion(mp, "size"); - } - return sc_factor(p); -} - -@ @<Declarations@>= -static void mp_clear_sizes (MP mp) ; - -@ @c void mp_clear_sizes (MP mp) { - font_number f; /* the font whose size list is being cleared */ - pointer p; /* current font size nodes */ - for (f=null_font+1;f<=mp->last_fnum;f++) { - while ( mp->font_sizes[f]!=null ) { - p=mp->font_sizes[f]; - mp->font_sizes[f]=link(p); - mp_free_node(mp, p,font_size_size); - } - } -} - -@ A text node may specify an arbitrary transformation but the usual case -involves only shifting, scaling, and occasionally rotation. The purpose -of |choose_scale| is to select a scale factor so that the remaining -transformation is as ``nice'' as possible. The definition of ``nice'' -is somewhat arbitrary but shifting and $90^\circ$ rotation are especially -nice because they work out well for bitmap fonts. The code here selects -a scale factor equal to $1/\sqrt2$ times the Frobenius norm of the -non-shifting part of the transformation matrix. It is careful to avoid -additions that might cause undetected overflow. - - -@ @c static scaled mp_choose_scale (MP mp, mp_graphic_object *p) { - /* |p| should point to a text node */ - scaled a,b,c,d,ad,bc; /* temporary values */ - a=gr_txx_val(p); - b=gr_txy_val(p); - c=gr_tyx_val(p); - d=gr_tyy_val(p); - if ( (a<0) ) negate(a); - if ( (b<0) ) negate(b); - if ( (c<0) ) negate(c); - if ( (d<0) ) negate(d); - ad=half(a-d); - bc=half(b-c); - return mp_pyth_add(mp, mp_pyth_add(mp, d+ad,ad), mp_pyth_add(mp, c+bc,bc)); -} - -@ There may be many sizes of one font and we need to keep track of the -characters used for each size. This is done by keeping a linked list of -sizes for each font with a counter in each text node giving the appropriate -position in the size list for its font. - -@d font_size_size 2 /* size of a font size node */ - - -@ @<Declarations@>= -static void mp_apply_mark_string_chars(MP mp, mp_edge_object *h, int next_size); - -@ @c -void mp_apply_mark_string_chars(MP mp, mp_edge_object *h, int next_size) { - mp_graphic_object * p; - p=h->body; - while ( p!= NULL ) { - if ( gr_type(p)==mp_text_code ) { - if ( gr_font_n(p)!=null_font ) { - if ( gr_size_index(p)==(unsigned char)next_size ) - mp_mark_string_chars(mp, gr_font_n(p),gr_text_p(p),gr_text_l(p)); - } - } - p=gr_link(p); - } -} - -@ @<Unmark all marked characters@>= -for (f=null_font+1;f<=mp->last_fnum;f++) { - if ( mp->font_sizes[f]!=null ) { - mp_unmark_font(mp, f); - mp->font_sizes[f]=null; - } -} - -@ @<Scan all the text nodes and mark the used ...@>= -p=hh->body; -while ( p!=null ) { - if ( gr_type(p)==mp_text_code ) { - f = gr_font_n(p); - if (f!=null_font ) { - switch (prologues) { - case 2: - case 3: - mp->font_sizes[f] = mp_void; - mp_mark_string_chars(mp, f, gr_text_p(p),gr_text_l(p)); - if (mp_has_fm_entry(mp,f,NULL) ) { - if (mp->font_enc_name[f]==NULL ) - mp->font_enc_name[f] = mp_fm_encoding_name(mp,f); - mp->font_ps_name[f] = mp_fm_font_name(mp,f); - } - break; - case 1: - mp->font_sizes[f]=mp_void; - break; - default: - gr_size_index(p)=(unsigned char)mp_size_index(mp, f,mp_choose_scale(mp, p)); - if ( gr_size_index(p)==0 ) - mp_mark_string_chars(mp, f, gr_text_p(p),gr_text_l(p)); - } - } - } - p=gr_link(p); -} - - -@ -@d pen_is_elliptical(A) ((A)==gr_next_knot((A))) - -@<Exported function ...@>= -int mp_gr_ship_out (mp_edge_object *hh, int prologues, int procset, int standalone) ; - -@ @c -int mp_gr_ship_out (mp_edge_object *hh, int qprologues, int qprocset,int standalone) { - mp_graphic_object *p; - scaled ds,scf; /* design size and scale factor for a text node */ - font_number f; /* for loops over fonts while (un)marking characters */ - boolean transformed; /* is the coordinate system being transformed? */ - int prologues, procset; - MP mp = hh->parent; - if (standalone) { - mp->jump_buf = malloc(sizeof(jmp_buf)); - if (mp->jump_buf == NULL || setjmp(*(mp->jump_buf))) - return 0; - } - if (mp->history >= mp_fatal_error_stop ) return 1; - if (qprologues<0) - prologues = (int)((unsigned)mp->internal[mp_prologues]>>16); - else - prologues=qprologues; - if (qprocset<0) - procset = (int)((unsigned)mp->internal[mp_procset]>>16); - else - procset=qprocset; - mp_open_output_file(mp); - mp_print_initial_comment(mp, hh, prologues); - p = hh->body; - @<Unmark all marked characters@>; - if ( prologues==2 || prologues==3 ) { - mp_reload_encodings(mp); - } - @<Scan all the text nodes and mark the used characters@>; - if ( prologues==2 || prologues==3 ) { - mp_print_improved_prologue(mp, hh, prologues, procset); - } else { - mp_print_prologue(mp, hh, prologues, procset); - } - mp_gs_unknown_graphics_state(mp, 0); - p = hh->body; - while ( p!=NULL ) { - if ( gr_has_color(p) ) { - @<Write |pre_script| of |p|@>; - } - mp_gr_fix_graphics_state(mp, p); - switch (gr_type(p)) { - case mp_fill_code: - if ( gr_pen_p((mp_fill_object *)p)==NULL ) { - mp_gr_ps_fill_out(mp, gr_path_p((mp_fill_object *)p)); - } else if ( pen_is_elliptical(gr_pen_p((mp_fill_object *)p)) ) { - mp_gr_stroke_ellipse(mp, p,true); - } else { - mp_gr_ps_fill_out(mp, gr_path_p((mp_fill_object *)p)); - mp_gr_ps_fill_out(mp, gr_htap_p(p)); - } - if ( gr_post_script((mp_fill_object *)p)!=NULL ) { - mp_ps_print_nl (mp, gr_post_script((mp_fill_object *)p)); - mp_ps_print_ln(mp); - } - break; - case mp_stroked_code: - if ( pen_is_elliptical(gr_pen_p((mp_stroked_object *)p)) ) - mp_gr_stroke_ellipse(mp, p,false); - else { - mp_gr_ps_fill_out(mp, gr_path_p((mp_stroked_object *)p)); - } - if ( gr_post_script((mp_stroked_object *)p)!=NULL ) { - mp_ps_print_nl (mp, gr_post_script((mp_stroked_object *)p)); - mp_ps_print_ln(mp); - } - break; - case mp_text_code: - if ( (gr_font_n(p)!=null_font) && (gr_text_l(p)>0) ) { - if ( prologues>0 ) - scf=mp_gr_choose_scale(mp, p); - else - scf=mp_indexed_size(mp, gr_font_n(p), (quarterword)gr_size_index(p)); - @<Shift or transform as necessary before outputting text node~|p| at scale - factor~|scf|; set |transformed:=true| if the original transformation must - be restored@>; - mp_ps_string_out(mp, gr_text_p(p),gr_text_l(p)); - mp_ps_name_out(mp, mp->font_name[gr_font_n(p)],false); - @<Print the size information and \ps\ commands for text node~|p|@>; - mp_ps_print_ln(mp); - } - if ( gr_post_script((mp_text_object *)p)!=NULL ) { - mp_ps_print_nl (mp, gr_post_script((mp_text_object *)p)); mp_ps_print_ln(mp); - } - break; - case mp_start_clip_code: - mp_ps_print_nl(mp, ""); mp_ps_print_cmd(mp, "gsave ","q "); - mp_gr_ps_path_out(mp, gr_path_p((mp_clip_object *)p)); - mp_ps_print_cmd(mp, " clip"," W"); - mp_ps_print_ln(mp); - if ( mp->internal[mp_restore_clip_color]>0 ) - mp_gs_unknown_graphics_state(mp, 1); - break; - case mp_stop_clip_code: - mp_ps_print_nl(mp, ""); mp_ps_print_cmd(mp, "grestore","Q"); - mp_ps_print_ln(mp); - if ( mp->internal[mp_restore_clip_color]>0 ) - mp_gs_unknown_graphics_state(mp, 2); - else - mp_gs_unknown_graphics_state(mp, -1); - break; - case mp_start_bounds_code: - case mp_stop_bounds_code: - break; - case mp_special_code: - { - mp_special_object *ps = (mp_special_object *)p; - mp_ps_print_nl (mp, gr_pre_script(ps)); - mp_ps_print_ln (mp); - } - break; - } /* all cases are enumerated */ - p=gr_link(p); - } - mp_ps_print_cmd(mp, "showpage","P"); mp_ps_print_ln(mp); - mp_ps_print(mp, "%%EOF"); mp_ps_print_ln(mp); - (mp->close_file)(mp,mp->ps_file); - if ( prologues<=0 ) - mp_clear_sizes(mp); - return 1; -} - -@ @(mplibps.h@>= -int mp_ps_ship_out (mp_edge_object *hh, int prologues, int procset) ; - -@ @c -int mp_ps_ship_out (mp_edge_object *hh, int prologues, int procset) { - return mp_gr_ship_out (hh, prologues, procset, (int)true); -} - - - - - -@ -@d do_write_prescript(a,b) { - if ( (gr_pre_script((b *)a))!=NULL ) { - mp_ps_print_nl (mp, gr_pre_script((b *)a)); - mp_ps_print_ln(mp); - } -} - -@<Write |pre_script| of |p|@>= -{ - if (gr_type(p)==mp_fill_code) { do_write_prescript(p,mp_fill_object); } - else if (gr_type(p)==mp_stroked_code) { do_write_prescript(p,mp_stroked_object); } - else if (gr_type(p)==mp_text_code) { do_write_prescript(p,mp_text_object); } -} - -@ @<Print the size information and \ps\ commands for text node~|p|@>= -ps_room(18); -mp_ps_print_char(mp, ' '); -ds=(mp->font_dsize[gr_font_n(p)]+8) / 16; -mp_ps_print_scaled(mp, mp_take_scaled(mp, ds,scf)); -mp_ps_print(mp, " fshow"); -if ( transformed ) - mp_ps_print_cmd(mp, " grestore"," Q") - - - -@ @<Shift or transform as necessary before outputting text node~|p| at...@>= -transformed=(gr_txx_val(p)!=scf)||(gr_tyy_val(p)!=scf)|| - (gr_txy_val(p)!=0)||(gr_tyx_val(p)!=0); -if ( transformed ) { - mp_ps_print_cmd(mp, "gsave [", "q ["); - mp_ps_pair_out(mp, mp_make_scaled(mp, gr_txx_val(p),scf), - mp_make_scaled(mp, gr_tyx_val(p),scf)); - mp_ps_pair_out(mp, mp_make_scaled(mp, gr_txy_val(p),scf), - mp_make_scaled(mp, gr_tyy_val(p),scf)); - mp_ps_pair_out(mp, gr_tx_val(p),gr_ty_val(p)); - mp_ps_print_cmd(mp, "] concat 0 0 moveto","] t 0 0 m"); -} else { - mp_ps_pair_out(mp, gr_tx_val(p),gr_ty_val(p)); - mp_ps_print_cmd(mp, "moveto","m"); -} -mp_ps_print_ln(mp) - -@ @(mplibps.h@>= -void mp_gr_toss_objects ( mp_edge_object *hh) ; -void mp_gr_toss_object (mp_graphic_object *p) ; - -@ @c -void mp_gr_toss_object (mp_graphic_object *p) { - mp_fill_object *tf; - mp_stroked_object *ts; - mp_text_object *tt; - switch (gr_type(p)) { - case mp_fill_code: - tf = (mp_fill_object *)p; - mp_xfree(gr_pre_script(tf)); - mp_xfree(gr_post_script(tf)); - mp_gr_toss_knot_list(mp,gr_pen_p(tf)); - mp_gr_toss_knot_list(mp,gr_path_p(tf)); - mp_gr_toss_knot_list(mp,gr_htap_p(p)); - break; - case mp_stroked_code: - ts = (mp_stroked_object *)p; - mp_xfree(gr_pre_script(ts)); - mp_xfree(gr_post_script(ts)); - mp_gr_toss_knot_list(mp,gr_pen_p(ts)); - mp_gr_toss_knot_list(mp,gr_path_p(ts)); - if (gr_dash_p(p)!=NULL) - mp_gr_toss_dashes (mp,gr_dash_p(p)); - break; - case mp_text_code: - tt = (mp_text_object *)p; - mp_xfree(gr_pre_script(tt)); - mp_xfree(gr_post_script(tt)); - mp_xfree(gr_text_p(p)); - mp_xfree(gr_font_name(p)); - break; - case mp_start_clip_code: - mp_gr_toss_knot_list(mp,gr_path_p((mp_clip_object *)p)); - break; - case mp_start_bounds_code: - mp_gr_toss_knot_list(mp,gr_path_p((mp_bounds_object *)p)); - break; - case mp_stop_clip_code: - case mp_stop_bounds_code: - break; - case mp_special_code: - mp_xfree(gr_pre_script((mp_special_object *)p)); - break; - } /* all cases are enumerated */ - mp_xfree(p); -} - - -@ @c -void mp_gr_toss_objects (mp_edge_object *hh) { - mp_graphic_object *p, *q; - p = hh->body; - while ( p!=NULL ) { - q = gr_link(p); - mp_gr_toss_object(p); - p=q; - } - mp_xfree(hh->filename); - mp_xfree(hh); -} - -@ @(mplibps.h@>= -mp_graphic_object *mp_gr_copy_object (MP mp, mp_graphic_object *p) ; - -@ @c -mp_graphic_object * -mp_gr_copy_object (MP mp, mp_graphic_object *p) { - mp_fill_object *tf; - mp_stroked_object *ts; - mp_text_object *tt; - mp_clip_object *tc; - mp_bounds_object *tb; - mp_special_object *tp; - mp_graphic_object *q = NULL; - switch (gr_type(p)) { - case mp_fill_code: - tf = (mp_fill_object *)mp_new_graphic_object(mp, mp_fill_code); - gr_pre_script(tf) = mp_xstrdup(mp, gr_pre_script((mp_fill_object *)p)); - gr_post_script(tf) = mp_xstrdup(mp, gr_post_script((mp_fill_object *)p)); - gr_path_p(tf) = mp_gr_copy_path(mp,gr_path_p((mp_fill_object *)p)); - gr_htap_p(tf) = mp_gr_copy_path(mp,gr_htap_p(p)); - gr_pen_p(tf) = mp_gr_copy_path(mp,gr_pen_p((mp_fill_object *)p)); - q = (mp_graphic_object *)tf; - break; - case mp_stroked_code: - ts = (mp_stroked_object *)mp_new_graphic_object(mp, mp_stroked_code); - gr_pre_script(ts) = mp_xstrdup(mp, gr_pre_script((mp_stroked_object *)p)); - gr_post_script(ts) = mp_xstrdup(mp, gr_post_script((mp_stroked_object *)p)); - gr_path_p(ts) = mp_gr_copy_path(mp,gr_path_p((mp_stroked_object *)p)); - gr_pen_p(ts) = mp_gr_copy_path(mp,gr_pen_p((mp_stroked_object *)p)); - gr_dash_p(ts) = mp_gr_copy_dashes(mp,gr_dash_p(p)); - q = (mp_graphic_object *)ts; - break; - case mp_text_code: - tt = (mp_text_object *)mp_new_graphic_object(mp, mp_text_code); - gr_pre_script(tt) = mp_xstrdup(mp, gr_pre_script((mp_text_object *)p)); - gr_post_script(tt) = mp_xstrdup(mp, gr_post_script((mp_text_object *)p)); - gr_text_p(tt) = mp_xstrldup(mp, gr_text_p(p), gr_text_l(p)); - gr_text_l(tt) = gr_text_l(p); - gr_font_name(tt) = mp_xstrdup(mp, gr_font_name(p)); - q = (mp_graphic_object *)tt; - break; - case mp_start_clip_code: - tc = (mp_clip_object *)mp_new_graphic_object(mp, mp_start_clip_code); - gr_path_p(tc) = mp_gr_copy_path(mp,gr_path_p((mp_clip_object *)p)); - q = (mp_graphic_object *)tc; - break; - case mp_start_bounds_code: - tb = (mp_bounds_object *)mp_new_graphic_object(mp, mp_start_bounds_code); - gr_path_p(tb) = mp_gr_copy_path(mp,gr_path_p((mp_bounds_object *)p)); - q = (mp_graphic_object *)tb; - break; - case mp_special_code: - tp = (mp_special_object *)mp_new_graphic_object(mp, mp_special_code); - gr_pre_script(tp) = mp_xstrdup(mp, gr_pre_script((mp_special_object *)p)); - q = (mp_graphic_object *)tp; - break; - case mp_stop_clip_code: - q = mp_new_graphic_object(mp, mp_stop_clip_code); - break; - case mp_stop_bounds_code: - q = mp_new_graphic_object(mp, mp_stop_bounds_code); - break; - } /* all cases are enumerated */ - return q; -} - diff --git a/Build/source/texk/web2c/luatexdir/mp/tfmin.w b/Build/source/texk/web2c/luatexdir/mp/tfmin.w deleted file mode 100644 index 8b9ef84ef73..00000000000 --- a/Build/source/texk/web2c/luatexdir/mp/tfmin.w +++ /dev/null @@ -1,242 +0,0 @@ -% $Id: mp.w 597 2008-07-03 15:35:34Z taco $ -% -% Copyright 2008 Taco Hoekwater. -% -% This program is free software: you can redistribute it and/or modify -% it under the terms of the GNU General Public License as published by -% the Free Software Foundation, either version 2 of the License, or -% (at your option) any later version. -% -% This program is distributed in the hope that it will be useful, -% but WITHOUT ANY WARRANTY; without even the implied warranty of -% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -% GNU General Public License for more details. -% -% You should have received a copy of the GNU General Public License -% along with this program. If not, see <http://www.gnu.org/licenses/>. -% -% TeX is a trademark of the American Mathematical Society. -% METAFONT is a trademark of Addison-Wesley Publishing Company. -% PostScript is a trademark of Adobe Systems Incorporated. - -% Here is TeX material that gets inserted after \input webmac - -\font\tenlogo=logo10 % font used for the METAFONT logo -\font\logos=logosl10 -\def\MF{{\tenlogo META}\-{\tenlogo FONT}} -\def\MP{{\tenlogo META}\-{\tenlogo POST}} - -\def\title{Reading TEX metrics files} -\pdfoutput=1 - -@ Introduction. - -@ Needed headers and macros - -@d qi(A) (quarterword)(A) /* to store eight bits in a quarterword */ -@d null_font 0 /* the |font_number| for an empty font */ -@d false 0 -@d true 1 -@d hlp1(A) mp->help_line[0]=A; } -@d hlp2(A,B) mp->help_line[1]=A; hlp1(B) -@d hlp3(A,B,C) mp->help_line[2]=A; hlp2(B,C) -@d help3 { mp->help_ptr=3; hlp3 /* use this with three help lines */ - -@c -#include "config.h" -#include <stdio.h> -#include <stdlib.h> -#include <string.h> -#include "mplib.h" -#include "mpmp.h" /* internal header */ -@h - -@ The |font_ps_name| for a built-in font should be what PostScript expects. -A preliminary name is obtained here from the \.{TFM} name as given in the -|fname| argument. This gets updated later from an external table if necessary. - -@c -font_number mp_read_font_info (MP mp, char *fname) { - boolean file_opened; /* has |tfm_infile| been opened? */ - font_number n; /* the number to return */ - halfword lf,tfm_lh,bc,ec,nw,nh,nd; /* subfile size parameters */ - size_t whd_size; /* words needed for heights, widths, and depths */ - int i,ii; /* |font_info| indices */ - int jj; /* counts bytes to be ignored */ - scaled z; /* used to compute the design size */ - fraction d; /* height, width, or depth as a fraction of design size times $2^{-8}$ */ - int h_and_d; /* height and depth indices being unpacked */ - int tfbyte = 0; /* a byte read from the file */ - n=null_font; - @<Open |tfm_infile| for input@>; - @<Read data from |tfm_infile|; if there is no room, say so and |goto done|; - otherwise |goto bad_tfm| or |goto done| as appropriate@>; -BAD_TFM: - @<Complain that the \.{TFM} file is bad@>; -DONE: - if ( file_opened ) (mp->close_file)(mp,mp->tfm_infile); - if ( n!=null_font ) { - mp->font_ps_name[n]=mp_xstrdup(mp,fname); - mp->font_name[n]=mp_xstrdup(mp,fname); - } - return n; -} - -@ \MP\ doesn't bother to check the entire \.{TFM} file for errors or explain -precisely what is wrong if it does find a problem. Programs called \.{TFtoPL} -@.TFtoPL@> @.PLtoTF@> -and \.{PLtoTF} can be used to debug \.{TFM} files. - -@<Complain that the \.{TFM} file is bad@>= -mp_print_err(mp,"Font "); -mp_print(mp, fname); -if ( file_opened ) mp_print(mp, " not usable: TFM file is bad"); -else mp_print(mp, " not usable: TFM file not found"); -help3("I wasn't able to read the size data for this font so this", - "`infont' operation won't produce anything. If the font name", - "is right, you might ask an expert to make a TFM file"); -if ( file_opened ) - mp->help_line[0]="is right, try asking an expert to fix the TFM file"; -mp_error(mp) - -@ @<Read data from |tfm_infile|; if there is no room, say so...@>= -@<Read the \.{TFM} size fields@>; -@<Use the size fields to allocate space in |font_info|@>; -@<Read the \.{TFM} header@>; -@<Read the character data and the width, height, and depth tables and - |goto done|@> - -@ A bad \.{TFM} file can be shorter than it claims to be. The code given here -might try to read past the end of the file if this happens. Changes will be -needed if it causes a system error to refer to |tfm_infile^| or call -|get_tfm_infile| when |eof(tfm_infile)| is true. For example, the definition -@^system dependencies@> -of |tfget| could be changed to -``|begin get(tfm_infile); if eof(tfm_infile) then goto bad_tfm; end|.'' - -@d tfget do { - size_t wanted=1; - unsigned char abyte=0; - void *tfbyte_ptr = &abyte; - (mp->read_binary_file)(mp,mp->tfm_infile, &tfbyte_ptr,&wanted); - if (wanted==0) goto BAD_TFM; - tfbyte = (int)abyte; -} while (0) -@d read_two(A) { (A)=tfbyte; - if ( (A)>127 ) goto BAD_TFM; - tfget; (A)=(A)*0400+tfbyte; -} -@d tf_ignore(A) { for (jj=(A);jj>=1;jj--) tfget; } - -@<Read the \.{TFM} size fields@>= -tfget; read_two(lf); -tfget; read_two(tfm_lh); -tfget; read_two(bc); -tfget; read_two(ec); -if ( (bc>1+ec)||(ec>255) ) goto BAD_TFM; -tfget; read_two(nw); -tfget; read_two(nh); -tfget; read_two(nd); -whd_size=(size_t)((ec+1-bc)+nw+nh+nd); -if ( lf<(int)(6+tfm_lh+whd_size) ) goto BAD_TFM; -tf_ignore(10) - -@ Offsets are added to |char_base[n]| and |width_base[n]| so that is not -necessary to apply the |so| and |qo| macros when looking up the width of a -character in the string pool. In order to ensure nonnegative |char_base| -values when |bc>0|, it may be necessary to reserve a few unused |font_info| -elements. - -@<Use the size fields to allocate space in |font_info|@>= -if ( mp->next_fmem<(size_t)bc) - mp->next_fmem=(size_t)bc; /* ensure nonnegative |char_base| */ -if (mp->last_fnum==mp->font_max) - mp_reallocate_fonts(mp,(mp->font_max+(mp->font_max/4))); -while (mp->next_fmem+whd_size>=mp->font_mem_size) { - size_t l = mp->font_mem_size+(mp->font_mem_size/4); - memory_word *font_info; - font_info = mp_xmalloc (mp,(l+1),sizeof(memory_word)); - memset (font_info,0,sizeof(memory_word)*(l+1)); - memcpy (font_info,mp->font_info,sizeof(memory_word)*(mp->font_mem_size+1)); - mp_xfree(mp->font_info); - mp->font_info = font_info; - mp->font_mem_size = l; -} -mp->last_fnum++; -n=mp->last_fnum; -mp->font_bc[n]=(eight_bits)bc; -mp->font_ec[n]=(eight_bits)ec; -mp->char_base[n]=(int)(mp->next_fmem-bc); -mp->width_base[n]=(int)(mp->next_fmem+ec-bc+1); -mp->height_base[n]=mp->width_base[n]+nw; -mp->depth_base[n]=mp->height_base[n]+nh; -mp->next_fmem=mp->next_fmem+whd_size; - - -@ @<Read the \.{TFM} header@>= -if ( tfm_lh<2 ) goto BAD_TFM; -tf_ignore(4); -tfget; read_two(z); -tfget; z=z*0400+tfbyte; -tfget; z=z*0400+tfbyte; /* now |z| is 16 times the design size */ -mp->font_dsize[n]=mp_take_fraction(mp, z,267432584); - /* times ${72\over72.27}2^{28}$ to convert from \TeX\ points */ -tf_ignore(4*(tfm_lh-2)) - -@ @<Read the character data and the width, height, and depth tables...@>= -ii=mp->width_base[n]; -i=mp->char_base[n]+bc; -while ( i<ii ) { - tfget; mp->font_info[i].qqqq.b0=qi(tfbyte); - tfget; h_and_d=tfbyte; - mp->font_info[i].qqqq.b1=qi(h_and_d / 16); - mp->font_info[i].qqqq.b2=qi(h_and_d % 16); - tfget; tfget; - i++; -} -while ( i<(int)mp->next_fmem ) { - @<Read a four byte dimension, scale it by the design size, store it in - |font_info[i]|, and increment |i|@>; -} -goto DONE - -@ The raw dimension read into |d| should have magnitude at most $2^{24}$ when -interpreted as an integer, and this includes a scale factor of $2^{20}$. Thus -we can multiply it by sixteen and think of it as a |fraction| that has been -divided by sixteen. This cancels the extra scale factor contained in -|font_dsize[n|. - -@<Read a four byte dimension, scale it by the design size, store it in...@>= -{ -tfget; d=tfbyte; -if ( d>=0200 ) d=d-0400; -tfget; d=d*0400+tfbyte; -tfget; d=d*0400+tfbyte; -tfget; d=d*0400+tfbyte; -mp->font_info[i].cint=mp_take_fraction(mp, d*16,mp->font_dsize[n]); -i++; -} - -@ This function does no longer use the file name parser, because |fname| is -a C string already. - -@<Open |tfm_infile| for input@>= -file_opened=false; -mp_ptr_scan_file(mp, fname); -if ( strlen(mp->cur_area)==0 ) { mp_xfree(mp->cur_area); mp->cur_area=NULL; } -if ( strlen(mp->cur_ext)==0 ) { - mp_xfree(mp->cur_ext); - mp->cur_ext=mp_xstrdup(mp,".tfm"); -} -mp_pack_file_name(mp, mp->cur_name,mp->cur_area,mp->cur_ext); -mp->tfm_infile = (mp->open_file)(mp, mp->name_of_file, "r",mp_filetype_metrics); -if ( !mp->tfm_infile ) goto BAD_TFM; -file_opened=true - - - - - - - - diff --git a/Build/source/texk/web2c/mpdir/am/mp.am b/Build/source/texk/web2c/mpdir/am/mp.am index f237c8c8d9a..6ebb12ea563 100644 --- a/Build/source/texk/web2c/mpdir/am/mp.am +++ b/Build/source/texk/web2c/mpdir/am/mp.am @@ -3,19 +3,19 @@ ## MetaPost ## if MP -bin_PROGRAMS += mpost +bin_PROGRAMS += oldmpost endif MP -EXTRA_PROGRAMS += mpost +EXTRA_PROGRAMS += oldmpost -mpost_CPPFLAGS = -I$(srcdir)/mpdir -mpost_LDADD = libmpost.a $(LDADD) -mpost_c_h = mpini.c mp0.c mp1.c mp2.c mpcoerce.h mpd.h -nodist_mpost_SOURCES = $(mpost_c_h) mp-pool.c mpextra.c -$(mpost_c_h): mp-web2c +oldmpost_CPPFLAGS = -I$(srcdir)/mpdir +oldmpost_LDADD = liboldmpost.a $(LDADD) +oldmpost_c_h = mpini.c mp0.c mp1.c mp2.c mpcoerce.h mpd.h +nodist_oldmpost_SOURCES = $(oldmpost_c_h) mp-pool.c mpextra.c +$(oldmpost_c_h): mp-web2c mp-web2c: mp.p $(web2c_texmf) mpdir/mp.defines web2c/cvtmf1.sed web2c/cvtmf2.sed $(web2c) mp echo timestamp >$@ - touch $(mpost_c_h) + touch $(oldmpost_c_h) EXTRA_DIST += mp.web mp.ch lib/texmfmp.c mpdir/mp.defines mpdir/mplib.h mpextra.c: lib/texmfmp.c mpd.h sed s/TEX-OR-MF-OR-MP/mp/ $(srcdir)/lib/texmfmp.c >$@ @@ -26,16 +26,16 @@ mp-tangle: tangle$(EXEEXT) mp.web mp.ch touch mp.p mp.pool mp-pool.c: mp.pool $(makecpool) mpdir/mplib.h $(makecpool) mp.pool $(srcdir)/mpdir/mplib.h >$@ || rm -f $@ -DISTCLEANFILES += $(nodist_mpost_SOURCES) mp-web2c \ +DISTCLEANFILES += $(nodist_oldmpost_SOURCES) mp-web2c \ mp.p mp.pool mp-tangle -## libmpost +## liboldmpost ## -EXTRA_LIBRARIES += libmpost.a +EXTRA_LIBRARIES += liboldmpost.a -libmpost_a_CPPFLAGS = -I$(srcdir)/mpdir +liboldmpost_a_CPPFLAGS = -I$(srcdir)/mpdir -libmpost_a_SOURCES = \ +liboldmpost_a_SOURCES = \ mpdir/avl.c \ mpdir/avl.h \ mpdir/avlstuff.c \ @@ -48,8 +48,8 @@ libmpost_a_SOURCES = \ mpdir/writefont.c \ mpdir/writet1.c -## We must create mpd.h before building the libmpost_a_OBJECTS. -$(libmpost_a_OBJECTS): mpd.h +## We must create mpd.h before building the liboldmpost_a_OBJECTS. +$(liboldmpost_a_OBJECTS): mpd.h ## Eventually delete these files ## diff --git a/Build/source/texk/web2c/mplibdir/am/libmplib.am b/Build/source/texk/web2c/mplibdir/am/libmplib.am new file mode 100644 index 00000000000..491054dadfe --- /dev/null +++ b/Build/source/texk/web2c/mplibdir/am/libmplib.am @@ -0,0 +1,54 @@ +## texk/web2c/mplibdir/am/libmplib.am: Makefile fragment for libmplib. + +## libmplib.a, used by MetaPost and luaTeX +## +EXTRA_LIBRARIES += libmplib.a + +libmplib_a_CPPFLAGS = -I$(srcdir)/mplibdir + +## libmplib C sources +libmplib_a_SOURCES = mplibdir/avl.h mplibdir/avl.c +nodist_libmplib_a_SOURCES = memio.c tfmin.c +nodist_libmplib_a_SOURCES += $(mp_c_h) $(psout_c_h) $(svgout_c_h) +mp_c_h = mp.c mplib.h mpmp.h +psout_c_h = mppsout.h psout.c mplibps.h +svgout_c_h = mplibsvg.h mpsvgout.h svgout.c + +memio.c: ctangle$(EXEEXT) mplibdir/memio.w + $(mp_ctangle) memio.w + +tfmin.c: ctangle$(EXEEXT) mplibdir/tfmin.w + $(mp_ctangle) tfmin.w + +$(mp_c_h): mp-ctangle +mp-ctangle: ctangle$(EXEEXT) mplibdir/mp.w + $(mp_ctangle) mp.w + echo timestamp >$@ + touch $(mp_c_h) + +$(psout_c_h): psout-ctangle +psout-ctangle: ctangle$(EXEEXT) mplibdir/psout.w + $(mp_ctangle) psout.w + echo timestamp >$@ + touch $(psout_c_h) + +$(svgout_c_h): svgout-ctangle +svgout-ctangle: ctangle$(EXEEXT) mplibdir/svgout.w + $(mp_ctangle) svgout.w + echo timestamp >$@ + touch $(svgout_c_h) + +## libmplib CWeb sources +libmplib_web = mplibdir/mp.w mplibdir/psout.w mplibdir/svgout.w +libmplib_web += mplibdir/memio.w mplibdir/tfmin.w + +$(libmplib_a_OBJECTS): $(nodist_libmplib_a_SOURCES) + +EXTRA_DIST += $(libmplib_web) + +DISTCLEANFILES += $(nodist_libmplib_a_SOURCES) \ + mp-ctangle psout-ctangle svgout-ctangle + +## only used by luaTeX +EXTRA_DIST += mplibdir/lmplib.c + diff --git a/Build/source/texk/web2c/mplibdir/am/mplib.am b/Build/source/texk/web2c/mplibdir/am/mplib.am index 26414bf8dfe..3256bc925c3 100644 --- a/Build/source/texk/web2c/mplibdir/am/mplib.am +++ b/Build/source/texk/web2c/mplibdir/am/mplib.am @@ -1,60 +1,37 @@ ## texk/web2c/mplibdir/am/mplib.am: Makefile fragment for MetaPost. -## metapost +## MetaPost ## if MP -bin_PROGRAMS += newmpost +bin_PROGRAMS += mpost endif MP -EXTRA_PROGRAMS += newmpost +EXTRA_PROGRAMS += mpost -EXTRA_LIBRARIES += libmplib.a +mp_ctangle = CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) -newmpost_c_h = mpost.c mpxout.c mpxout.h -newmpost_web = mplibdir/mpost.w mplibdir/mpxout.w +mpost_CPPFLAGS = -I$(srcdir)/mplibdir +mpost_DEPENDENCIES = libmplib.a +mpost_LDADD = libmplib.a $(KPATHSEA_LIBS) -lm -EXTRA_DIST += $(newmpost_web) +## MetaPost C sources +nodist_mpost_SOURCES = mpost.c $(mpxout_c_h) +mpxout_c_h = mpxout.c mpxout.h -newmpost_CPPFLAGS = -I$(srcdir)/mplibdir -newmpost_DEPENDENCIES = libmplib.a -newmpost_LDADD = libmplib.a $(KPATHSEA_LIBS) -lm -nodist_newmpost_SOURCES = $(newmpost_c_h) +mpost.c: ctangle$(EXEEXT) mplibdir/mpost.w + $(mp_ctangle) mpost.w -$(newmpost_c_h): mpost-ctangle libmplib.a -mpost-ctangle: ctangle$(EXEEXT) $(newmpost_web) - CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) mpost.w - CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) mpxout.w +$(mpxout_c_h): mpxout-ctangle +mpxout-ctangle: ctangle$(EXEEXT) mplibdir/mpxout.w + $(mp_ctangle) mpxout.w echo timestamp >$@ - touch $(newmpost_c_h) - -DISTCLEANFILES += $(newmpost_c_h) mpost-ctangle - -## These files are mutually dependent -libmplib_c_h = mp.c mplib.h mpmp.h -libmplib_c_h += mppsout.h psout.c mplibps.h -libmplib_c_h += mplibsvg.h mpsvgout.h svgout.c -libmplib_c_h += memio.c tfmin.c -libmplib_true_c = mplibdir/avl.h mplibdir/avl.c -libmplib_web = $(libmplib_true_c) mplibdir/mp.w mplibdir/psout.w -libmplib_web += mplibdir/svgout.w mplibdir/memio.w mplibdir/tfmin.w - -libmplib_a_CPPFLAGS = -I$(srcdir)/mplibdir -nodist_libmplib_a_SOURCES = $(libmplib_c_h) -libmplib_a_SOURCES = $(libmplib_true_c) - -$(libmplib_c_h): mplib-ctangle $(libmplib_true_c) -mplib-ctangle: ctangle$(EXEEXT) $(libmplib_web) - CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) mp.w - CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) psout.w - CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) svgout.w - CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) tfmin.w - CWEBINPUTS=$(srcdir)/mplibdir $(ctangle) memio.w - echo timestamp >$@ - touch $(libmplib_c_h) + touch $(mpxout_c_h) + +## MetaPost CWeb sources +mpost_web = mplibdir/mpost.w mplibdir/mpxout.w -EXTRA_DIST += $(libmplib_web) +$(mpost_OBJECTS): $(nodist_mpost_SOURCES) libmplib.a -DISTCLEANFILES += $(libmplib_c_h) mplib-ctangle +EXTRA_DIST += $(mpost_web) -## only used by luatex, perhaps should not be mentioned here -EXTRA_DIST += mplibdir/lmplib.c +DISTCLEANFILES += $(nodist_mpost_SOURCES) mpxout-ctangle |