diff options
| author | Peter Breitenlohner <peb@mppmu.mpg.de> | 2009-05-26 12:53:54 +0000 |
|---|---|---|
| committer | Peter Breitenlohner <peb@mppmu.mpg.de> | 2009-05-26 12:53:54 +0000 |
| commit | 0f26e1a8f3c5c5bcb5031bec4eccedaf313ca534 (patch) | |
| tree | b097c422b3d1f50c51f5028efcbe9ae2bd13196f | |
| parent | 7bb4da4874329b18005da3776ac861b406092782 (diff) | |
remove obsolete Web2C versions of ofm2opl, opl2ofm, ovf2ovp, and ovp2ovf
since quite some time replaced by symlinks to omfonts
git-svn-id: svn://tug.org/texlive/trunk@13481 c570f23f-e606-0410-a88d-b1316a301751
19 files changed, 157 insertions, 17159 deletions
diff --git a/Build/source/libs/configure.in.orig b/Build/source/libs/configure.in.orig deleted file mode 100644 index 08d22036d5d..00000000000 --- a/Build/source/libs/configure.in.orig +++ /dev/null @@ -1,84 +0,0 @@ -dnl configure.in for TeX Live source/libs. -dnl Public domain. -AC_INIT(zlib/zlib.h) - -AC_CONFIG_AUX_DIR(../config) -AC_PROG_MAKE_SET -AC_PROG_CC -AC_CANONICAL_SYSTEM -AC_PROG_INSTALL -AC_PROG_MAKE_SET -AC_PROG_LN_S -AC_FUNC_ALLOCA -AC_PROG_RANLIB -AM_MAINTAINER_MODE - -sinclude(../texk/kpathsea/withenable.ac) -sinclude(ncurses/withenable.ac) -sinclude(ncurses/ncurses.ac) -sinclude(zlib/withenable.ac) -sinclude(zlib/zlib.ac) -sinclude(libpng/withenable.ac) -sinclude(libpng/libpng.ac) -sinclude(t1lib/withenable.ac) -sinclude(t1lib/t1lib.ac) -sinclude(freetype/withenable.ac) -sinclude(freetype/freetype.ac) -sinclude(freetype2/withenable.ac) -sinclude(freetype2/freetype2.ac) -sinclude(gd/withenable.ac) -sinclude(gd/gd.ac) -sinclude(icu-xetex/withenable.ac) -sinclude(icu-xetex/icu-xetex.ac) -sinclude(teckit/teckit.ac) -sinclude(graphite-engine/withenable.ac) -sinclude(graphite-engine/graphite-engine.ac) - -# The following line helps, e.g. for ncurses which properly detects the -# system's terminfo definitions if configured without explicit --prefix. -# ac_configure_args=`echo "$ac_configure_args" | sed 's@--prefix=[[^ ]]*@@'` - -if test "x$needs_ncurses" != xno && test "$using_system_ncurses" != yes; then - AC_CONFIG_SUBDIRS([ncurses]) -fi -if test "x$needs_zlib" != xno && test "$using_system_zlib" != yes; then - KPSE_CONFIG_FILES([zlib/Makefile]) -fi -if test "x$needs_pnglib" != xno && test "$using_system_pnglib" != yes; then - KPSE_CONFIG_FILES([libpng/Makefile]) -fi -if test "x$needs_libxpdf" != xno; then - AC_CONFIG_SUBDIRS([xpdf]) -fi -if test "x$needs_libt1" != xno && test "$using_system_t1lib" != yes; then - AC_CONFIG_SUBDIRS([t1lib type1]) -fi -if test "x$needs_freetype" != xno && test "$using_system_freetype" != yes; then - AC_CONFIG_SUBDIRS([freetype]) -fi -if test "x$needs_freetype2" != xno && test "$using_system_freetype2" != yes; then - AC_CONFIG_SUBDIRS([freetype2]) -fi -if test "x$needs_gd" != xno && test "$using_system_gd" != yes; then - AC_CONFIG_SUBDIRS([gd]) -fi -if test "x$needs_icu" != xno && test "$using_system_icu" != yes; then - ac_configure_args="$ac_configure_args --enable-static" - AC_CONFIG_SUBDIRS([icu-xetex]) -fi -if test "x$needs_teckit" != xno; then - AC_CONFIG_SUBDIRS([teckit]) -fi -if test "x$needs_graphite" != xno; then - AC_CONFIG_SUBDIRS([graphite-engine]) -fi -if test "x$needs_obsdcompat" != xno; then - AC_CONFIG_SUBDIRS([obsdcompat]) -fi - -# create md5 directory when building outside the srcdir: -if test -d $srcdir/md5; then - test -d md5 || mkdir md5 -fi - -AC_OUTPUT diff --git a/Build/source/texk/Makefile.in.orig b/Build/source/texk/Makefile.in.orig deleted file mode 100644 index 48bff423245..00000000000 --- a/Build/source/texk/Makefile.in.orig +++ /dev/null @@ -1,91 +0,0 @@ -# @configure_input@ -# Top-level Makefile for kpathsea-using programs. - -# Package subdirectories, the library, and all subdirectories. -ESUBDIRS=@ESUBDIRS@ - -programs = web2c $(ESUBDIRS) -kpathsea_dir = kpathsea -all_dirs = $(programs) $(kpathsea_dir) - -kpse_include make/paths.mk -kpse_include make/makevars.mk - -# It's too bad we have to pass all these down, but I see no alternative, -# if we are to propagate changes at the top level. -# XMAKEARGS is for the user to override. -makeargs = $(MFLAGS) CC='$(CC)' CFLAGS='$(CFLAGS)' LDFLAGS='$(LDFLAGS)' $(makevars) $(XMAKEARGS) -installargs = $(makeargs) - -# Not everything from common.mk is relevant to this top-level -# Makefile, but most of it is, and it doesn't seem worth separating the -# compilation-specific stuff. -kpse_include make/common.mk - -# Get more of the default setup. -kpse_include make/programs.mk - -# kpathsea is not a sibling, it's a child. -kpathsea_parent = . - -# Make the library before the programs. -# Always make all, rather than $@, because automake-generated Makefiles, -# among others, do not have a default target. -# Use if ... rather than || or && because Ultrix sh exits for -# no good reason with the latter. -default all: do-kpathsea - for d in $(programs); do if test -f $$d/Makefile; then \ - (cd $$d && $(MAKE) $(makeargs) all) || exit 1; else true; fi; done - -install install-data install-exec: - for d in kpathsea $(programs); do if test -f $$d/Makefile; then \ - (cd $$d && $(MAKE) $(installargs) $@) || exit 1; else true; fi; done - -# Other standard targets for everything. -uninstall uninstall-exec uninstall-data \ -mostlyclean clean realclean extraclean configclean \ -info dvi check depend:: - for d in $(all_dirs); do if test -f $$d/Makefile; then \ - (cd $$d && $(MAKE) $(makeargs) $@) || exit 1; else true; fi; done - -distclean:: - rm -rf conftest* - -distclean:: - for d in $(all_dirs); do if test -f $$d/Makefile; then \ - (cd $$d && $(MAKE) $(makeargs) $@) || exit 1; else true; fi; done - -distclean realclean:: - rm -f Makefile Makefile.aux config.status config.cache config.log libtool - -# Unconditionally remake the library, since we don't want to write out -# the dependencies here. -do-kpathsea: - cd $(kpathsea_dir) && $(MAKE) $(makeargs) - -# Targets that only apply to web2c. -triptrap trip trap mptrap \ -formats fmts bases mems \ -install-formats install-fmts install-bases install-mems \ -install-links c-sources: do-kpathsea - cd web2c && $(MAKE) $(makeargs) $@ - -@MAINT@ac_dir = $(srcdir)/etc/autoconf -@MAINT@autoconf = $(ac_dir)/acspecific.m4 $(ac_dir)/acgeneral.m4 $(ac_dir)/acsite.m4 -@MAINT@configure_in = $(srcdir)/configure.in -@MAINT@$(srcdir)/configure: $(configure_in) $(srcdir)/withenable.ac $(autoconf) -@MAINT@ cd $(srcdir) && $(srcdir)/autoconf2.13 -m $(ac_dir) -@MAINT@ -@MAINT@# And make sure that --enable-maintainer-mode is used if configure is -@MAINT@# called from the makefiles. We do not try to do this through the -@MAINT@# cache, lest the option sneaks into a global cache file. -@MAINT@enablemaintflag = --enable-maintainer-mode - -config.status: $(srcdir)/configure - $(SHELL) $(srcdir)/configure --no-create --verbose $(enablemaintflag) - -Makefile: $(srcdir)/Makefile.in config.status - $(SHELL) config.status - -TAGS: - find $(srcdir) \( -name '*.[cCfFhilsy]' -o -name '*.el' \) | etags - diff --git a/Build/source/texk/configure.in.orig b/Build/source/texk/configure.in.orig deleted file mode 100644 index 8c7cf884b9e..00000000000 --- a/Build/source/texk/configure.in.orig +++ /dev/null @@ -1,57 +0,0 @@ -dnl Public domain. Originally written many years ago by Karl Berry and -dnl Thomas Esser, and others. -dnl -dnl Top-level configure for kpathsea-using programs. -dnl Our job is to run configure in the relevant subdirectories. -dnl -dnl Assumption: each program will create a c-auto.h that defines -dnl everything kpathsea needs. We arrange this by including (at -dnl autoconf time) kpathsea/common.ac. -dnl -dnl Consequence: we don't need to run configure in the kpathsea directory -dnl itself; we can just copy from a program directory. We'll use the -dnl first one. -dnl -AC_INIT(kpathsea/kpathsea.texi) - -dnl These configure scripts won't work with anything else. -AC_PREREQ(2.59) - -AC_PROG_MAKE_SET - -dnl Because we include make/common.make. -AC_PROG_CC -AC_ISC_POSIX -AC_PROG_LN_S - -dnl If we guessed the prefix in the subdirectories, it might guess -dnl differently than the prefix here, and that would cause confusion. -AC_PREFIX_PROGRAM(tex) - -dnl Pass this down from the top level so that when the subprograms -dnl install kpathsea a command line value is propagated. -AC_PROG_INSTALL - -dnl If the other programs ever acquire their own --with or --enable -dnl options, they must be added, so configure --help at the top level -dnl will show all the options. -sinclude(libtool.m4) -sinclude(withenable.ac) -sinclude(kpathsea/withenable.ac) -sinclude(web2c/withenable.ac) -sinclude(xdvik/withenable.ac) - -AC_PROG_LIBTOOL - -if test "x$with_x" = xno; then - with_xdvik=no -fi - -dnl required subdirs -AC_CONFIG_SUBDIRS([kpathsea web2c]) - -dnl optional subdirs => ESUBDIRS -KPSE_CONFIG_SUBDIRS(kpse_texk_pkglist) - -KPSE_CONFIG_FILES([Makefile]) -AC_OUTPUT diff --git a/Build/source/texk/web2c/Makefile.am b/Build/source/texk/web2c/Makefile.am index 0cba816c221..f8093486eea 100644 --- a/Build/source/texk/web2c/Makefile.am +++ b/Build/source/texk/web2c/Makefile.am @@ -9,11 +9,7 @@ INCLUDES = -I$(top_builddir)/.. $(KPATHSEA_INCLUDES) version = $(WEB2CVERSION) -SUBDIRS = doc lib man web2c . window -if OMFONTS -SUBDIRS += omegafonts -endif OMFONTS -SUBDIRS += otps +SUBDIRS = doc lib man web2c . window omegafonts otps proglib = lib/lib.a diff --git a/Build/source/texk/web2c/Makefile.in b/Build/source/texk/web2c/Makefile.in index 09a6989af48..c302087cc8d 100644 --- a/Build/source/texk/web2c/Makefile.in +++ b/Build/source/texk/web2c/Makefile.in @@ -34,25 +34,24 @@ PRE_UNINSTALL = : POST_UNINSTALL = : 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) etex$(EXEEXT) pdftex$(EXEEXT) \ ttf2afm$(EXEEXT) pdftosrc$(EXEEXT) luatex$(EXEEXT) \ - luatangle$(EXEEXT) xetex$(EXEEXT) $(am__EXEEXT_4) \ + luatangle$(EXEEXT) xetex$(EXEEXT) $(am__EXEEXT_2) \ aleph$(EXEEXT) -bin_PROGRAMS = tangle$(EXEEXT) ctangle$(EXEEXT) $(am__EXEEXT_5) \ - ctie$(EXEEXT) cweave$(EXEEXT) tie$(EXEEXT) $(am__EXEEXT_6) \ - $(am__EXEEXT_7) $(am__EXEEXT_8) $(am__EXEEXT_9) \ - $(am__EXEEXT_10) $(am__EXEEXT_11) $(am__EXEEXT_12) \ - $(am__EXEEXT_13) $(am__EXEEXT_14) $(am__EXEEXT_15) \ - $(am__EXEEXT_16) synctex$(EXEEXT) +bin_PROGRAMS = tangle$(EXEEXT) ctangle$(EXEEXT) $(am__EXEEXT_3) \ + ctie$(EXEEXT) cweave$(EXEEXT) tie$(EXEEXT) $(am__EXEEXT_4) \ + $(am__EXEEXT_5) $(am__EXEEXT_6) $(am__EXEEXT_7) \ + $(am__EXEEXT_8) $(am__EXEEXT_9) $(am__EXEEXT_10) \ + $(am__EXEEXT_11) $(am__EXEEXT_12) $(am__EXEEXT_13) \ + synctex$(EXEEXT) noinst_PROGRAMS = tangleboot$(EXEEXT) ctangleboot$(EXEEXT) -check_PROGRAMS = $(am__EXEEXT_17) $(am__EXEEXT_18) $(am__EXEEXT_19) \ - $(am__EXEEXT_20) md5main$(EXEEXT) -TESTS = tangle.test $(am__EXEEXT_23) ctiedir/ctie.test \ - cwebdir/cweave.test tiedir/tie.test $(am__append_5) \ - $(am__append_9) $(am__append_12) $(am__append_15) \ - $(am__append_20) $(am__append_36) libmd5/md5.test +check_PROGRAMS = $(am__EXEEXT_14) $(am__EXEEXT_15) $(am__EXEEXT_16) \ + $(am__EXEEXT_17) md5main$(EXEEXT) +TESTS = tangle.test $(am__EXEEXT_20) ctiedir/ctie.test \ + cwebdir/cweave.test tiedir/tie.test $(am__append_4) \ + $(am__append_8) $(am__append_11) $(am__append_14) \ + $(am__append_19) $(am__append_34) libmd5/md5.test DIST_COMMON = README $(am__configure_deps) $(dist_man_MANS) \ $(srcdir)/../../build-aux/config.guess \ $(srcdir)/../../build-aux/config.sub \ @@ -88,45 +87,45 @@ DIST_COMMON = README $(am__configure_deps) $(dist_man_MANS) \ ../../build-aux/ltmain.sh ../../build-aux/missing \ ../../build-aux/mkinstalldirs ../../build-aux/texinfo.tex \ ../../build-aux/ylwrap AUTHORS ChangeLog INSTALL NEWS -@WEB_TRUE@am__append_2 = $(web_programs) -@WEB_TRUE@am__append_3 = $(web_tests) -@TEX_TRUE@am__append_4 = tex -@TEX_TRUE@am__append_5 = $(tex_tests) -@TEX_TRUE@am__append_6 = dvitype pltotf tftopl -@MF_TRUE@am__append_7 = mf -@MFN_TRUE@@MF_TRUE@am__append_8 = mf-nowin -@MF_TRUE@am__append_9 = $(mf_tests) -@MF_TRUE@am__append_10 = gftype tftopl -@MP_TRUE@am__append_11 = mpost -@MP_TRUE@am__append_12 = $(mp_tests) -@MP_TRUE@am__append_13 = pltotf tftopl -@ETEX_TRUE@am__append_14 = etex -@ETEX_TRUE@am__append_15 = $(etex_tests) -@ETEX_TRUE@am__append_16 = dvitype pltotf tftopl -@PDFTEX_TRUE@am__append_17 = pdftex ttf2afm pdftosrc -@MINGW32_TRUE@am__append_18 = \ +@WEB_TRUE@am__append_1 = $(web_programs) +@WEB_TRUE@am__append_2 = $(web_tests) +@TEX_TRUE@am__append_3 = tex +@TEX_TRUE@am__append_4 = $(tex_tests) +@TEX_TRUE@am__append_5 = dvitype pltotf tftopl +@MF_TRUE@am__append_6 = mf +@MFN_TRUE@@MF_TRUE@am__append_7 = mf-nowin +@MF_TRUE@am__append_8 = $(mf_tests) +@MF_TRUE@am__append_9 = gftype tftopl +@MP_TRUE@am__append_10 = mpost +@MP_TRUE@am__append_11 = $(mp_tests) +@MP_TRUE@am__append_12 = pltotf tftopl +@ETEX_TRUE@am__append_13 = etex +@ETEX_TRUE@am__append_14 = $(etex_tests) +@ETEX_TRUE@am__append_15 = dvitype pltotf tftopl +@PDFTEX_TRUE@am__append_16 = pdftex ttf2afm pdftosrc +@MINGW32_TRUE@am__append_17 = \ @MINGW32_TRUE@ pdftexdir/regex/regex.c \ @MINGW32_TRUE@ pdftexdir/regex/regex.h -@LUATEX_TRUE@am__append_19 = luatex luatangle -@LUATEX_TRUE@am__append_20 = luatexdir/luatangle.test -@MINGW32_FALSE@am__append_21 = -DLUA_USE_POSIX -@XETEX_TRUE@am__append_22 = xetex -@XETEX_MACOSX_TRUE@am__append_23 = -DXETEX_MAC -@XETEX_MACOSX_TRUE@am__append_24 = libxetexmm.a -@XETEX_MACOSX_FALSE@am__append_25 = -DXETEX_OTHER $(XPDF_INCLUDES) \ +@LUATEX_TRUE@am__append_18 = luatex luatangle +@LUATEX_TRUE@am__append_19 = luatexdir/luatangle.test +@MINGW32_FALSE@am__append_20 = -DLUA_USE_POSIX +@XETEX_TRUE@am__append_21 = xetex +@XETEX_MACOSX_TRUE@am__append_22 = -DXETEX_MAC +@XETEX_MACOSX_TRUE@am__append_23 = libxetexmm.a +@XETEX_MACOSX_FALSE@am__append_24 = -DXETEX_OTHER $(XPDF_INCLUDES) \ @XETEX_MACOSX_FALSE@ $(LIBPNG_INCLUDES) $(FONTCONFIG_INCLUDES) -@XETEX_MACOSX_FALSE@am__append_26 = $(XPDF_LIBS) $(LIBPNG_LIBS) $(FONTCONFIG_LIBS) -@XETEX_MACOSX_FALSE@am__append_27 = $(XPDF_DEPEND) $(LIBPNG_DEPEND) -@XETEX_GRAPHITE_TRUE@am__append_28 = -DXETEX_GRAPHITE $(GRAPHITE_INCLUDES) -@XETEX_GRAPHITE_TRUE@am__append_29 = $(GRAPHITE_LIBS) -@XETEX_GRAPHITE_TRUE@am__append_30 = $(GRAPHITE_DEPEND) -@XETEX_MACOSX_TRUE@am__append_31 = \ +@XETEX_MACOSX_FALSE@am__append_25 = $(XPDF_LIBS) $(LIBPNG_LIBS) $(FONTCONFIG_LIBS) +@XETEX_MACOSX_FALSE@am__append_26 = $(XPDF_DEPEND) $(LIBPNG_DEPEND) +@XETEX_GRAPHITE_TRUE@am__append_27 = -DXETEX_GRAPHITE $(GRAPHITE_INCLUDES) +@XETEX_GRAPHITE_TRUE@am__append_28 = $(GRAPHITE_LIBS) +@XETEX_GRAPHITE_TRUE@am__append_29 = $(GRAPHITE_DEPEND) +@XETEX_MACOSX_TRUE@am__append_30 = \ @XETEX_MACOSX_TRUE@ xetexdir/XeTeXFontInst_Mac.cpp \ @XETEX_MACOSX_TRUE@ xetexdir/XeTeXFontInst_Mac.h \ @XETEX_MACOSX_TRUE@ xetexdir/XeTeX_mac.c -@XETEX_MACOSX_FALSE@am__append_32 = \ +@XETEX_MACOSX_FALSE@am__append_31 = \ @XETEX_MACOSX_FALSE@ xetexdir/XeTeXFontMgr_FC.cpp \ @XETEX_MACOSX_FALSE@ xetexdir/XeTeXFontMgr_FC.h \ @XETEX_MACOSX_FALSE@ xetexdir/XeTeX_pic.c \ @@ -143,30 +142,29 @@ DIST_COMMON = README $(am__configure_deps) $(dist_man_MANS) \ @XETEX_MACOSX_FALSE@ xetexdir/pngimage.c \ @XETEX_MACOSX_FALSE@ xetexdir/pngimage.h -@XETEX_GRAPHITE_TRUE@am__append_33 = \ +@XETEX_GRAPHITE_TRUE@am__append_32 = \ @XETEX_GRAPHITE_TRUE@ xetexdir/XeTeXGrLayout.cpp \ @XETEX_GRAPHITE_TRUE@ xetexdir/XeTeXGrLayout.h -@OTANGLE_TRUE@am__append_34 = $(omegaware_tools) -@OMFONTS_FALSE@@OTANGLE_TRUE@am__append_35 = $(omegaware_font_tools) -@OTANGLE_TRUE@am__append_36 = omegaware/otangle.test -@ALEPH_TRUE@am__append_37 = aleph -@TEX_SYNCTEX_TRUE@am__append_38 = -I$(srcdir)/synctexdir $(ZLIB_INCLUDES) -@TEX_SYNCTEX_TRUE@am__append_39 = $(ZLIB_LIBS) -@TEX_SYNCTEX_TRUE@am__append_40 = \ +@OTANGLE_TRUE@am__append_33 = $(omegaware_programs) +@OTANGLE_TRUE@am__append_34 = omegaware/otangle.test +@ALEPH_TRUE@am__append_35 = aleph +@TEX_SYNCTEX_TRUE@am__append_36 = -I$(srcdir)/synctexdir $(ZLIB_INCLUDES) +@TEX_SYNCTEX_TRUE@am__append_37 = $(ZLIB_LIBS) +@TEX_SYNCTEX_TRUE@am__append_38 = \ @TEX_SYNCTEX_TRUE@ synctex.c -@ETEX_SYNCTEX_TRUE@am__append_41 = -I$(srcdir)/synctexdir $(ZLIB_INCLUDES) -@ETEX_SYNCTEX_TRUE@am__append_42 = $(ZLIB_LIBS) -@ETEX_SYNCTEX_TRUE@am__append_43 = \ +@ETEX_SYNCTEX_TRUE@am__append_39 = -I$(srcdir)/synctexdir $(ZLIB_INCLUDES) +@ETEX_SYNCTEX_TRUE@am__append_40 = $(ZLIB_LIBS) +@ETEX_SYNCTEX_TRUE@am__append_41 = \ @ETEX_SYNCTEX_TRUE@ synctex-e.c -@PDFTEX_SYNCTEX_TRUE@am__append_44 = -I$(srcdir)/synctexdir -@PDFTEX_SYNCTEX_TRUE@am__append_45 = \ +@PDFTEX_SYNCTEX_TRUE@am__append_42 = -I$(srcdir)/synctexdir +@PDFTEX_SYNCTEX_TRUE@am__append_43 = \ @PDFTEX_SYNCTEX_TRUE@ synctex-pdf.c -@XETEX_SYNCTEX_TRUE@am__append_46 = -I$(srcdir)/synctexdir -@XETEX_SYNCTEX_TRUE@am__append_47 = \ +@XETEX_SYNCTEX_TRUE@am__append_44 = -I$(srcdir)/synctexdir +@XETEX_SYNCTEX_TRUE@am__append_45 = \ @XETEX_SYNCTEX_TRUE@ synctex-xe.c subdir = . @@ -441,29 +439,25 @@ am__EXEEXT_1 = bibtex$(EXEEXT) dvicopy$(EXEEXT) dvitype$(EXEEXT) \ pltotf$(EXEEXT) pooltype$(EXEEXT) tftopl$(EXEEXT) \ vftovp$(EXEEXT) vptovf$(EXEEXT) weave$(EXEEXT) am__EXEEXT_2 = odvicopy$(EXEEXT) odvitype$(EXEEXT) otangle$(EXEEXT) -am__EXEEXT_3 = ofm2opl$(EXEEXT) opl2ofm$(EXEEXT) ovf2ovp$(EXEEXT) \ - ovp2ovf$(EXEEXT) -am__EXEEXT_4 = $(am__EXEEXT_2) $(am__EXEEXT_3) -@WEB_TRUE@am__EXEEXT_5 = $(am__EXEEXT_1) -@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) -@ETEX_TRUE@am__EXEEXT_10 = etex$(EXEEXT) -@PDFTEX_TRUE@am__EXEEXT_11 = pdftex$(EXEEXT) ttf2afm$(EXEEXT) \ +@WEB_TRUE@am__EXEEXT_3 = $(am__EXEEXT_1) +@TEX_TRUE@am__EXEEXT_4 = tex$(EXEEXT) +@MF_TRUE@am__EXEEXT_5 = mf$(EXEEXT) +@MFN_TRUE@@MF_TRUE@am__EXEEXT_6 = mf-nowin$(EXEEXT) +@MP_TRUE@am__EXEEXT_7 = mpost$(EXEEXT) +@ETEX_TRUE@am__EXEEXT_8 = etex$(EXEEXT) +@PDFTEX_TRUE@am__EXEEXT_9 = pdftex$(EXEEXT) ttf2afm$(EXEEXT) \ @PDFTEX_TRUE@ pdftosrc$(EXEEXT) -@LUATEX_TRUE@am__EXEEXT_12 = luatex$(EXEEXT) luatangle$(EXEEXT) -@XETEX_TRUE@am__EXEEXT_13 = xetex$(EXEEXT) -@OTANGLE_TRUE@am__EXEEXT_14 = $(am__EXEEXT_2) -@OMFONTS_FALSE@@OTANGLE_TRUE@am__EXEEXT_15 = $(am__EXEEXT_3) -@ALEPH_TRUE@am__EXEEXT_16 = aleph$(EXEEXT) +@LUATEX_TRUE@am__EXEEXT_10 = luatex$(EXEEXT) luatangle$(EXEEXT) +@XETEX_TRUE@am__EXEEXT_11 = xetex$(EXEEXT) +@OTANGLE_TRUE@am__EXEEXT_12 = $(am__EXEEXT_2) +@ALEPH_TRUE@am__EXEEXT_13 = aleph$(EXEEXT) am__installdirs = "$(DESTDIR)$(bindir)" "$(DESTDIR)$(man1dir)" \ "$(DESTDIR)$(man5dir)" -@TEX_TRUE@am__EXEEXT_17 = dvitype$(EXEEXT) pltotf$(EXEEXT) \ +@TEX_TRUE@am__EXEEXT_14 = dvitype$(EXEEXT) pltotf$(EXEEXT) \ @TEX_TRUE@ tftopl$(EXEEXT) -@MF_TRUE@am__EXEEXT_18 = gftype$(EXEEXT) tftopl$(EXEEXT) -@MP_TRUE@am__EXEEXT_19 = pltotf$(EXEEXT) tftopl$(EXEEXT) -@ETEX_TRUE@am__EXEEXT_20 = dvitype$(EXEEXT) pltotf$(EXEEXT) \ +@MF_TRUE@am__EXEEXT_15 = gftype$(EXEEXT) tftopl$(EXEEXT) +@MP_TRUE@am__EXEEXT_16 = pltotf$(EXEEXT) tftopl$(EXEEXT) +@ETEX_TRUE@am__EXEEXT_17 = dvitype$(EXEEXT) pltotf$(EXEEXT) \ @ETEX_TRUE@ tftopl$(EXEEXT) PROGRAMS = $(bin_PROGRAMS) $(noinst_PROGRAMS) am_aleph_OBJECTS = aleph-aleph.$(OBJEXT) aleph-alephbis.$(OBJEXT) @@ -570,26 +564,10 @@ nodist_odvitype_OBJECTS = odvitype.$(OBJEXT) odvitype_OBJECTS = $(nodist_odvitype_OBJECTS) odvitype_LDADD = $(LDADD) odvitype_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1) -nodist_ofm2opl_OBJECTS = ofm2opl.$(OBJEXT) -ofm2opl_OBJECTS = $(nodist_ofm2opl_OBJECTS) -ofm2opl_LDADD = $(LDADD) -ofm2opl_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1) -nodist_opl2ofm_OBJECTS = opl2ofm.$(OBJEXT) -opl2ofm_OBJECTS = $(nodist_opl2ofm_OBJECTS) -opl2ofm_LDADD = $(LDADD) -opl2ofm_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1) nodist_otangle_OBJECTS = otangle.$(OBJEXT) otangle_OBJECTS = $(nodist_otangle_OBJECTS) otangle_LDADD = $(LDADD) otangle_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1) -nodist_ovf2ovp_OBJECTS = ovf2ovp.$(OBJEXT) -ovf2ovp_OBJECTS = $(nodist_ovf2ovp_OBJECTS) -ovf2ovp_LDADD = $(LDADD) -ovf2ovp_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1) -nodist_ovp2ovf_OBJECTS = ovp2ovf.$(OBJEXT) -ovp2ovf_OBJECTS = $(nodist_ovp2ovf_OBJECTS) -ovp2ovf_LDADD = $(LDADD) -ovp2ovf_DEPENDENCIES = $(proglib) $(am__DEPENDENCIES_1) nodist_patgen_OBJECTS = patgen.$(OBJEXT) patgen_OBJECTS = $(nodist_patgen_OBJECTS) patgen_LDADD = $(LDADD) @@ -732,9 +710,7 @@ SOURCES = $(libff_a_SOURCES) $(liblua51_a_SOURCES) \ $(md5main_SOURCES) $(nodist_mf_SOURCES) \ $(nodist_mf_nowin_SOURCES) $(nodist_mft_SOURCES) \ $(nodist_mpost_SOURCES) $(nodist_odvicopy_SOURCES) \ - $(nodist_odvitype_SOURCES) $(nodist_ofm2opl_SOURCES) \ - $(nodist_opl2ofm_SOURCES) $(nodist_otangle_SOURCES) \ - $(nodist_ovf2ovp_SOURCES) $(nodist_ovp2ovf_SOURCES) \ + $(nodist_odvitype_SOURCES) $(nodist_otangle_SOURCES) \ $(nodist_patgen_SOURCES) $(dist_pdftex_SOURCES) \ $(nodist_pdftex_SOURCES) $(nodist_EXTRA_pdftex_SOURCES) \ $(pdftosrc_SOURCES) $(nodist_EXTRA_pdftosrc_SOURCES) \ @@ -801,13 +777,13 @@ ETAGS = etags CTAGS = ctags am__tty_colors = \ red=; grn=; lgn=; blu=; std= -am__EXEEXT_21 = bibtex.test dvicopy.test dvitype.test gftodvi.test \ +am__EXEEXT_18 = bibtex.test dvicopy.test dvitype.test gftodvi.test \ gftopk.test gftype.test mft.test patgen.test pktogf.test \ pktype.test pltotf.test pooltype.test tftopl.test vftovp.test \ vptovf.test weave.test -am__EXEEXT_22 = $(am__EXEEXT_21) -@WEB_TRUE@am__EXEEXT_23 = $(am__EXEEXT_22) -DIST_SUBDIRS = doc lib man web2c . window omegafonts otps +am__EXEEXT_19 = $(am__EXEEXT_18) +@WEB_TRUE@am__EXEEXT_20 = $(am__EXEEXT_19) +DIST_SUBDIRS = $(SUBDIRS) DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) distdir = $(PACKAGE)-$(VERSION) top_distdir = $(distdir) @@ -1023,7 +999,7 @@ x_tool_libs = @x_tool_libs@ ACLOCAL_AMFLAGS = -I ../../m4 INCLUDES = -I$(top_builddir)/.. $(KPATHSEA_INCLUDES) version = $(WEB2CVERSION) -SUBDIRS = doc lib man web2c . window $(am__append_1) otps +SUBDIRS = doc lib man web2c . window omegafonts otps proglib = lib/lib.a dist_man_MANS = synctexdir/man1/synctex.1 synctexdir/man5/synctex.5 nodist_man_MANS = ctiedir/ctie.1 tiedir/tie.1 @@ -1216,27 +1192,25 @@ EXTRA_DIST = PROJECTS cftests config.h cpascal.h help.h tangle.web \ xetexdir/ChangeLog xetexdir/LICENSE.txt \ xetexdir/acx_pthread.m4 xetexdir/tests.ac \ xetexdir/withenable.ac xetexdir/xetex.mk omegaware/ChangeLog \ - $(odvicopy_sources) $(odvitype_sources) $(ofm2opl_sources) \ - $(opl2ofm_sources) $(otangle_sources) $(ovf2ovp_sources) \ - $(ovp2ovf_sources) omegaware/otangle.test $(aleph_web_srcs) \ - $(aleph_ch_srcs) lib/texmfmp.c alephdir/ChangeLog \ - alephdir/Makefile alephdir/aleph.defines \ - alephdir/aleph.version alephdir/eomega.ech alephdir/etex.ch \ - alephdir/omega.ch0 alephdir/omega.ch1 alephdir/omega.ch2 \ - alephdir/omxml.ch alephdir/aleph.mk synctexdir/INSTALL \ - synctexdir/Makefile synctexdir/Makefile.in \ - synctexdir/README.txt synctexdir/synctex-common.h \ - synctexdir/synctex-convert.sh synctexdir/synctex.c \ - synctexdir/synctex.defines synctexdir/synctex.h \ - synctexdir/synctex-mem.ch0 synctexdir/synctex-mem.ch1 \ - synctexdir/synctex-mem.ch2 synctexdir/synctex-rec.ch0 \ - synctexdir/synctex-rec.ch1 synctexdir/synctex-rec.ch2 \ - synctexdir/synctex-e-mem.ch0 synctexdir/synctex-e-mem.ch1 \ - 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.mk libmd5/md5.test fmtutil.in \ - Makefile.in.orig configure.in.orig + $(odvicopy_sources) $(odvitype_sources) $(otangle_sources) \ + omegaware/otangle.test $(aleph_web_srcs) $(aleph_ch_srcs) \ + lib/texmfmp.c alephdir/ChangeLog alephdir/Makefile \ + alephdir/aleph.defines alephdir/aleph.version \ + alephdir/eomega.ech alephdir/etex.ch alephdir/omega.ch0 \ + alephdir/omega.ch1 alephdir/omega.ch2 alephdir/omxml.ch \ + alephdir/aleph.mk synctexdir/INSTALL synctexdir/Makefile \ + synctexdir/Makefile.in synctexdir/README.txt \ + synctexdir/synctex-common.h synctexdir/synctex-convert.sh \ + synctexdir/synctex.c synctexdir/synctex.defines \ + synctexdir/synctex.h synctexdir/synctex-mem.ch0 \ + synctexdir/synctex-mem.ch1 synctexdir/synctex-mem.ch2 \ + synctexdir/synctex-rec.ch0 synctexdir/synctex-rec.ch1 \ + synctexdir/synctex-rec.ch2 synctexdir/synctex-e-mem.ch0 \ + synctexdir/synctex-e-mem.ch1 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.mk \ + libmd5/md5.test 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) \ @@ -1321,14 +1295,14 @@ web_tests = $(web_programs:=.test) nodist_ctie_SOURCES = ctie.c nodist_cweave_SOURCES = cweave.c cweb.c nodist_tie_SOURCES = tie.c -tex_CPPFLAGS = $(am__append_38) +tex_CPPFLAGS = $(am__append_36) # With --enable-ipc, TeX may need to link with -lsocket. -tex_LDADD = $(LDADD) $(ipc_socketlibs) $(am__append_39) +tex_LDADD = $(LDADD) $(ipc_socketlibs) $(am__append_37) # TeX C sources 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_40) +nodist_tex_SOURCES = $(tex_c_h) tex-pool.c texextra.c $(am__append_38) tex_ch_srcs = \ tex.web \ tex.ch \ @@ -1367,15 +1341,15 @@ 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_41) +etex_CPPFLAGS = $(am__append_39) # With --enable-ipc, e-TeX may need to link with -lsocket. -etex_LDADD = $(LDADD) $(ipc_socketlibs) $(am__append_42) +etex_LDADD = $(LDADD) $(ipc_socketlibs) $(am__append_40) # e-TeX C sources 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_43) + etexdir/etexextra.h $(am__append_41) etex_web_srcs = \ tex.web \ etexdir/etex.ch \ @@ -1399,12 +1373,12 @@ pdftex_dependencies = $(proglib) $(LIBPNG_DEPEND) $(ZLIB_DEPEND) \ $(XPDF_DEPEND) $(OBSDCOMPAT_DEPEND) libmd5.a nodist_EXTRA_pdftex_SOURCES = dummy.cxx pdf_tangle = WEBINPUTS=.:$(srcdir)/pdftexdir $(buildenv) $(TANGLE) -pdftex_CPPFLAGS = $(pdftex_cppflags) $(am__append_44) +pdftex_CPPFLAGS = $(pdftex_cppflags) $(am__append_42) pdftex_LDADD = $(pdftex_ldadd) $(LDADD) $(ipc_socketlibs) pdftex_DEPENDENCIES = $(pdftex_dependencies) libpdftex.a pdftex_c_h = pdftexini.c pdftex0.c pdftex1.c pdftex2.c pdftex3.c pdftexcoerce.h pdftexd.h nodist_pdftex_SOURCES = $(pdftex_c_h) pdftex-pool.c pdftexextra.c \ - pdftexdir/pdftexextra.h $(am__append_45) + pdftexdir/pdftexextra.h $(am__append_43) pdftex_ch_srcs = \ pdftexdir/pdftex.web \ pdftexdir/tex.ch0 \ @@ -1424,7 +1398,7 @@ libpdftex_a_SOURCES = pdftexdir/avl.c pdftexdir/avl.h \ pdftexdir/writejbig2.h pdftexdir/writejpg.c \ pdftexdir/writepng.c pdftexdir/writet1.c pdftexdir/writet3.c \ pdftexdir/writettf.c pdftexdir/writettf.h pdftexdir/writezip.c \ - $(am__append_18) + $(am__append_17) EXTRA_libpdftex_a_SOURCES = pdftexdir/macnames.c \ pdftexdir/regex/regcomp.c pdftexdir/regex/regex_internal.c \ pdftexdir/regex/regex_internal.h pdftexdir/regex/regexec.c @@ -1454,7 +1428,7 @@ nodist_luatex_SOURCES = $(luatex_c_h) luatex-pool.c luatexextra.c luatexdir/luat luatex_sources = luatexdir/luatex.web luatexdir/luatex.ch nodist_luatangle_SOURCES = luatangle.c luatangle.h luatangle_sources = luatexdir/luatangle.web luatexdir/luatangle.ch -liblua51_a_CPPFLAGS = -I$(top_srcdir)/luatexdir/lua51 $(am__append_21) +liblua51_a_CPPFLAGS = -I$(top_srcdir)/luatexdir/lua51 $(am__append_20) liblua51_a_SOURCES = \ luatexdir/lua51/lapi.c \ luatexdir/lua51/lapi.h \ @@ -1836,23 +1810,23 @@ libluatex_a_SOURCES = \ EXTRA_libluatex_a_SOURCES = luatexdir/font/macnames.c nodist_EXTRA_xetex_SOURCES = dummy.cxx -libxetex = libxetex.a $(am__append_24) +libxetex = libxetex.a $(am__append_23) xetex_cppflags = -DU_STATIC_IMPLEMENTATION -I$(srcdir)/xetexdir \ $(FREETYPE2_INCLUDES) $(ICU_INCLUDES) $(TECKIT_INCLUDES) \ - $(am__append_23) $(am__append_25) $(am__append_28) \ + $(am__append_22) $(am__append_24) $(am__append_27) \ $(ZLIB_INCLUDES) -xetex_ldadd = $(libxetex) $(ICU_LIBS) $(TECKIT_LIBS) $(am__append_26) \ - $(am__append_29) $(FREETYPE2_LIBS) $(ZLIB_LIBS) +xetex_ldadd = $(libxetex) $(ICU_LIBS) $(TECKIT_LIBS) $(am__append_25) \ + $(am__append_28) $(FREETYPE2_LIBS) $(ZLIB_LIBS) xetex_dependencies = $(proglib) $(ICU_DEPEND) $(TECKIT_DEPEND) \ - $(am__append_27) $(am__append_30) $(FREETYPE2_DEPEND) \ + $(am__append_26) $(am__append_29) $(FREETYPE2_DEPEND) \ $(ZLIB_DEPEND) @XETEX_MACOSX_TRUE@xetex_LDFLAGS = -framework Carbon -framework Cocoa -framework QuickTime -xetex_CPPFLAGS = $(xetex_cppflags) $(am__append_46) +xetex_CPPFLAGS = $(xetex_cppflags) $(am__append_44) 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 $(am__append_47) + xetexdir/xetexextra.h $(am__append_45) xetex_web_srcs = \ tex.web \ etexdir/etex.ch \ @@ -1876,32 +1850,22 @@ libxetex_a_SOURCES = xetexdir/MathTable.h xetexdir/FontTableCache.cpp \ xetexdir/XeTeXOTMath.h xetexdir/XeTeX_ext.c \ xetexdir/XeTeX_ext.h xetexdir/XeTeXswap.h xetexdir/cmaps.cpp \ xetexdir/cmaps.h xetexdir/sfnt.h xetexdir/trans.c \ - xetexdir/trans.h xetexdir/xetex.h $(am__append_31) \ - $(am__append_32) $(am__append_33) + xetexdir/trans.h xetexdir/xetex.h $(am__append_30) \ + $(am__append_31) $(am__append_32) libxetexmm_a_CPPFLAGS = $(xetex_cppflags) libxetexmm_a_CXXFLAGS = -ObjC++ libxetexmm_a_SOURCES = \ xetexdir/XeTeXFontMgr_Mac.cpp \ xetexdir/XeTeXFontMgr_Mac.h -omegaware_tools = odvicopy odvitype otangle -omegaware_font_tools = ofm2opl opl2ofm ovf2ovp ovp2ovf -omegaware_programs = $(omegaware_tools) $(omegaware_font_tools) +omegaware_programs = odvicopy odvitype otangle ow_tangle = WEBINPUTS=$(srcdir)/omegaware $(buildenv) $(TANGLE) nodist_odvicopy_SOURCES = odvicopy.c odvicopy.h odvicopy_sources = omegaware/odvicopy.web omegaware/odvicopy.ch nodist_odvitype_SOURCES = odvitype.c odvitype.h odvitype_sources = omegaware/odvitype.web omegaware/odvitype.ch -nodist_ofm2opl_SOURCES = ofm2opl.c ofm2opl.h -ofm2opl_sources = omegaware/ofm2opl.web omegaware/ofm2opl.ch -nodist_opl2ofm_SOURCES = opl2ofm.c opl2ofm.h -opl2ofm_sources = omegaware/opl2ofm.web omegaware/opl2ofm.ch nodist_otangle_SOURCES = otangle.c otangle.h otangle_sources = omegaware/otangle.web omegaware/otangle.ch -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) $(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 @@ -2274,21 +2238,9 @@ odvicopy$(EXEEXT): $(odvicopy_OBJECTS) $(odvicopy_DEPENDENCIES) odvitype$(EXEEXT): $(odvitype_OBJECTS) $(odvitype_DEPENDENCIES) @rm -f odvitype$(EXEEXT) $(LINK) $(odvitype_OBJECTS) $(odvitype_LDADD) $(LIBS) -ofm2opl$(EXEEXT): $(ofm2opl_OBJECTS) $(ofm2opl_DEPENDENCIES) - @rm -f ofm2opl$(EXEEXT) - $(LINK) $(ofm2opl_OBJECTS) $(ofm2opl_LDADD) $(LIBS) -opl2ofm$(EXEEXT): $(opl2ofm_OBJECTS) $(opl2ofm_DEPENDENCIES) - @rm -f opl2ofm$(EXEEXT) - $(LINK) $(opl2ofm_OBJECTS) $(opl2ofm_LDADD) $(LIBS) otangle$(EXEEXT): $(otangle_OBJECTS) $(otangle_DEPENDENCIES) @rm -f otangle$(EXEEXT) $(LINK) $(otangle_OBJECTS) $(otangle_LDADD) $(LIBS) -ovf2ovp$(EXEEXT): $(ovf2ovp_OBJECTS) $(ovf2ovp_DEPENDENCIES) - @rm -f ovf2ovp$(EXEEXT) - $(LINK) $(ovf2ovp_OBJECTS) $(ovf2ovp_LDADD) $(LIBS) -ovp2ovf$(EXEEXT): $(ovp2ovf_OBJECTS) $(ovp2ovf_DEPENDENCIES) - @rm -f ovp2ovf$(EXEEXT) - $(LINK) $(ovp2ovf_OBJECTS) $(ovp2ovf_LDADD) $(LIBS) patgen$(EXEEXT): $(patgen_OBJECTS) $(patgen_DEPENDENCIES) @rm -f patgen$(EXEEXT) $(LINK) $(patgen_OBJECTS) $(patgen_LDADD) $(LIBS) @@ -2649,11 +2601,7 @@ distclean-compile: @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)/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@ -@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ovp2ovf.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/patgen.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pdftex-dummy.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/pdftex-pdftex-pool.Po@am__quote@ @@ -8340,20 +8288,6 @@ odvitype-web2c: $(web2c_depend) odvitype.p touch odvitype.c odvitype.h odvitype.p: tangle$(EXEEXT) $(odvitype_sources) $(ow_tangle) odvitype odvitype -ofm2opl.c ofm2opl.h: ofm2opl-web2c -ofm2opl-web2c: $(web2c_depend) ofm2opl.p - $(web2c) ofm2opl - echo timestamp >$@ - touch ofm2opl.c ofm2opl.h -ofm2opl.p: tangle$(EXEEXT) $(ofm2opl_sources) - $(ow_tangle) ofm2opl ofm2opl -opl2ofm.c opl2ofm.h: opl2ofm-web2c -opl2ofm-web2c: $(web2c_depend) opl2ofm.p - $(web2c) opl2ofm - echo timestamp >$@ - touch opl2ofm.c opl2ofm.h -opl2ofm.p: tangle$(EXEEXT) $(opl2ofm_sources) - $(ow_tangle) opl2ofm opl2ofm otangle.c otangle.h: otangle-web2c otangle-web2c: $(web2c_depend) otangle.p $(web2c) otangle @@ -8361,20 +8295,6 @@ otangle-web2c: $(web2c_depend) otangle.p touch otangle.c otangle.h otangle.p: tangle$(EXEEXT) $(otangle_sources) $(ow_tangle) otangle otangle -ovf2ovp.c ovf2ovp.h: ovf2ovp-web2c -ovf2ovp-web2c: $(web2c_depend) ovf2ovp.p - $(web2c) ovf2ovp - echo timestamp >$@ - touch ovf2ovp.c ovf2ovp.h -ovf2ovp.p: tangle$(EXEEXT) $(ovf2ovp_sources) - $(ow_tangle) ovf2ovp ovf2ovp -ovp2ovf.c ovp2ovf.h: ovp2ovf-web2c -ovp2ovf-web2c: $(web2c_depend) ovp2ovf.p - $(web2c) ovp2ovf - echo timestamp >$@ - touch ovp2ovf.c ovp2ovf.h -ovp2ovf.p: tangle$(EXEEXT) $(ovp2ovf_sources) - $(ow_tangle) ovp2ovf ovp2ovf # We must create alephd.h before building the aleph_OBJECTS. $(aleph_OBJECTS): alephd.h diff --git a/Build/source/texk/web2c/configure b/Build/source/texk/web2c/configure index 442d6f60122..053dbbf12b0 100755 --- a/Build/source/texk/web2c/configure +++ b/Build/source/texk/web2c/configure @@ -860,8 +860,6 @@ MFN_FALSE MFN_TRUE MF_FALSE MF_TRUE -OMFONTS_FALSE -OMFONTS_TRUE OTANGLE_FALSE OTANGLE_TRUE XETEX_SYNCTEX_FALSE @@ -4561,13 +4559,13 @@ if test "${lt_cv_nm_interface+set}" = set; then else lt_cv_nm_interface="BSD nm" echo "int some_variable = 0;" > conftest.$ac_ext - (eval echo "\"\$as_me:4564: $ac_compile\"" >&5) + (eval echo "\"\$as_me:4562: $ac_compile\"" >&5) (eval "$ac_compile" 2>conftest.err) cat conftest.err >&5 - (eval echo "\"\$as_me:4567: $NM \\\"conftest.$ac_objext\\\"\"" >&5) + (eval echo "\"\$as_me:4565: $NM \\\"conftest.$ac_objext\\\"\"" >&5) (eval "$NM \"conftest.$ac_objext\"" 2>conftest.err > conftest.out) cat conftest.err >&5 - (eval echo "\"\$as_me:4570: output\"" >&5) + (eval echo "\"\$as_me:4568: output\"" >&5) cat conftest.out >&5 if $GREP 'External.*some_variable' conftest.out > /dev/null; then lt_cv_nm_interface="MS dumpbin" @@ -5773,7 +5771,7 @@ ia64-*-hpux*) ;; *-*-irix6*) # Find out which ABI we are using. - echo '#line 5776 "configure"' > conftest.$ac_ext + echo '#line 5774 "configure"' > conftest.$ac_ext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? @@ -7719,11 +7717,11 @@ else -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:7722: $lt_compile\"" >&5) + (eval echo "\"\$as_me:7720: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 - echo "$as_me:7726: \$? = $ac_status" >&5 + echo "$as_me:7724: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. @@ -8058,11 +8056,11 @@ else -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:8061: $lt_compile\"" >&5) + (eval echo "\"\$as_me:8059: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 - echo "$as_me:8065: \$? = $ac_status" >&5 + echo "$as_me:8063: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. @@ -8163,11 +8161,11 @@ else -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:8166: $lt_compile\"" >&5) + (eval echo "\"\$as_me:8164: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 - echo "$as_me:8170: \$? = $ac_status" >&5 + echo "$as_me:8168: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized @@ -8218,11 +8216,11 @@ else -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:8221: $lt_compile\"" >&5) + (eval echo "\"\$as_me:8219: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 - echo "$as_me:8225: \$? = $ac_status" >&5 + echo "$as_me:8223: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized @@ -11018,7 +11016,7 @@ else lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext <<_LT_EOF -#line 11021 "configure" +#line 11019 "configure" #include "confdefs.h" #if HAVE_DLFCN_H @@ -11114,7 +11112,7 @@ else lt_dlunknown=0; lt_dlno_uscore=1; lt_dlneed_uscore=2 lt_status=$lt_dlunknown cat > conftest.$ac_ext <<_LT_EOF -#line 11117 "configure" +#line 11115 "configure" #include "confdefs.h" #if HAVE_DLFCN_H @@ -16168,11 +16166,11 @@ else -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:16171: $lt_compile\"" >&5) + (eval echo "\"\$as_me:16169: $lt_compile\"" >&5) (eval "$lt_compile" 2>conftest.err) ac_status=$? cat conftest.err >&5 - echo "$as_me:16175: \$? = $ac_status" >&5 + echo "$as_me:16173: \$? = $ac_status" >&5 if (exit $ac_status) && test -s "$ac_outfile"; then # The compiler can only warn and ignore the option if not recognized # So say no if there are warnings other than the usual output. @@ -16267,11 +16265,11 @@ else -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:16270: $lt_compile\"" >&5) + (eval echo "\"\$as_me:16268: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 - echo "$as_me:16274: \$? = $ac_status" >&5 + echo "$as_me:16272: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized @@ -16319,11 +16317,11 @@ else -e 's:.*FLAGS}\{0,1\} :&$lt_compiler_flag :; t' \ -e 's: [^ ]*conftest\.: $lt_compiler_flag&:; t' \ -e 's:$: $lt_compiler_flag:'` - (eval echo "\"\$as_me:16322: $lt_compile\"" >&5) + (eval echo "\"\$as_me:16320: $lt_compile\"" >&5) (eval "$lt_compile" 2>out/conftest.err) ac_status=$? cat out/conftest.err >&5 - echo "$as_me:16326: \$? = $ac_status" >&5 + echo "$as_me:16324: \$? = $ac_status" >&5 if (exit $ac_status) && test -s out/conftest2.$ac_objext then # The compiler can only warn and ignore the option if not recognized @@ -18848,15 +18846,6 @@ else OTANGLE_FALSE= fi - if true; then - OMFONTS_TRUE= - OMFONTS_FALSE='#' -else - OMFONTS_TRUE='#' - OMFONTS_FALSE= -fi - - if test "x$enable_mf" != xno; then MF_TRUE= MF_FALSE='#' @@ -24969,13 +24958,6 @@ $as_echo "$as_me: error: conditional \"OTANGLE\" was never defined. Usually this means the macro was only invoked conditionally." >&2;} { (exit 1); exit 1; }; } fi -if test -z "${OMFONTS_TRUE}" && test -z "${OMFONTS_FALSE}"; then - { { $as_echo "$as_me:$LINENO: error: conditional \"OMFONTS\" was never defined. -Usually this means the macro was only invoked conditionally." >&5 -$as_echo "$as_me: error: conditional \"OMFONTS\" was never defined. -Usually this means the macro was only invoked conditionally." >&2;} - { (exit 1); exit 1; }; } -fi if test -z "${MF_TRUE}" && test -z "${MF_FALSE}"; then { { $as_echo "$as_me:$LINENO: error: conditional \"MF\" was never defined. Usually this means the macro was only invoked conditionally." >&5 diff --git a/Build/source/texk/web2c/configure.ac b/Build/source/texk/web2c/configure.ac index bd50318ab8e..bba9281374b 100644 --- a/Build/source/texk/web2c/configure.ac +++ b/Build/source/texk/web2c/configure.ac @@ -138,8 +138,6 @@ AS_IF([test "x$enable_aleph:$enable_xetex" = xno:no], AM_CONDITIONAL([OTANGLE], [test "x$enable_otangle" = xyes])[]dnl -AM_CONDITIONAL([OMFONTS], [true]) - AM_CONDITIONAL([MF], [test "x$enable_mf" != xno]) AM_CONDITIONAL([MFN], [test "x$enable_mf_nowin" != xno]) diff --git a/Build/source/texk/web2c/omegafonts/Makefile.am b/Build/source/texk/web2c/omegafonts/Makefile.am index 7f27bca4274..479fcf3c9a8 100644 --- a/Build/source/texk/web2c/omegafonts/Makefile.am +++ b/Build/source/texk/web2c/omegafonts/Makefile.am @@ -8,11 +8,11 @@ AM_YFLAGS = -d -v proglib = ../lib/lib.a -## Automake automatically uses $(proglib)=../lib/lib.a as dependency. -## This does not work for the configure substitution $(KPATHSEA_LIBS), -## thus we let $(proglib) artificially depend on $(KPATHSEA_LIBS). - -## Rebuild $(proglib) +# Automake automatically uses $(proglib)=../lib/lib.a as dependency. +# This does not work for the configure substitution $(KPATHSEA_LIBS), +# thus we let $(proglib) artificially depend on $(KPATHSEA_LIBS). +# +# Rebuild $(proglib) $(proglib): $(KPATHSEA_DEPEND) ${top_srcdir}/lib/*.c cd ../lib && $(MAKE) $(AM_MAKEFLAGS) @@ -74,8 +74,3 @@ unistall-hook: rm -f $(DESTDIR)$(bindir)/$$f$(EXEEXT); \ done -## ###### -## Eventually delete these files - -EXTRA_DIST = Makefile.in.orig - diff --git a/Build/source/texk/web2c/omegafonts/Makefile.in b/Build/source/texk/web2c/omegafonts/Makefile.in index da121312951..eae2202ad1a 100644 --- a/Build/source/texk/web2c/omegafonts/Makefile.in +++ b/Build/source/texk/web2c/omegafonts/Makefile.in @@ -329,7 +329,6 @@ omfonts_SOURCES = \ LDADD = $(LEXLIB) $(proglib) $(KPATHSEA_LIBS) DISTCLEANFILES = pl-parser.output linked_programs = ofm2opl opl2ofm ovf2ovp ovp2ovf -EXTRA_DIST = Makefile.in.orig all: all-am .SUFFIXES: @@ -678,6 +677,11 @@ uninstall-am: uninstall-binPROGRAMS uninstall-am uninstall-binPROGRAMS +# Automake automatically uses $(proglib)=../lib/lib.a as dependency. +# This does not work for the configure substitution $(KPATHSEA_LIBS), +# thus we let $(proglib) artificially depend on $(KPATHSEA_LIBS). +# +# Rebuild $(proglib) $(proglib): $(KPATHSEA_DEPEND) ${top_srcdir}/lib/*.c cd ../lib && $(MAKE) $(AM_MAKEFLAGS) diff --git a/Build/source/texk/web2c/omegaware/ChangeLog b/Build/source/texk/web2c/omegaware/ChangeLog index 17f28a7a438..3641928bb4e 100644 --- a/Build/source/texk/web2c/omegaware/ChangeLog +++ b/Build/source/texk/web2c/omegaware/ChangeLog @@ -1,3 +1,9 @@ +2009-05-26 Peter Breitenlohner <peb@mppmu.mpg.de> + + * {ofm2opl,opl2ofm,ovf2ovp,ovp2ovf}.{ch,web} (removed): + these Pascal Web versions are obsolete, replaced by symlinks + to omfonts (from ../omegafonts/). + 2009-03-03 Peter Breitenlohner <peb@mppmu.mpg.de> * otangle.ch: use kpse_open_file to locate input files, diff --git a/Build/source/texk/web2c/omegaware/am/omegaware.am b/Build/source/texk/web2c/omegaware/am/omegaware.am index 8cae810b4ee..4351dc680d7 100644 --- a/Build/source/texk/web2c/omegaware/am/omegaware.am +++ b/Build/source/texk/web2c/omegaware/am/omegaware.am @@ -3,15 +3,10 @@ ## Copyright (C) 2009 Peter Breitenlohner <tex-live@tug.org> ## You may freely use, modify and/or distribute this file. -omegaware_tools = odvicopy odvitype otangle -omegaware_font_tools = ofm2opl opl2ofm ovf2ovp ovp2ovf -omegaware_programs = $(omegaware_tools) $(omegaware_font_tools) +omegaware_programs = odvicopy odvitype otangle if OTANGLE -bin_PROGRAMS += $(omegaware_tools) -if !OMFONTS -bin_PROGRAMS += $(omegaware_font_tools) -endif !OMFONTS +bin_PROGRAMS += $(omegaware_programs) endif OTANGLE EXTRA_PROGRAMS += $(omegaware_programs) @@ -43,28 +38,6 @@ odvitype_sources = omegaware/odvitype.web omegaware/odvitype.ch odvitype.p: tangle$(EXEEXT) $(odvitype_sources) $(ow_tangle) odvitype odvitype -nodist_ofm2opl_SOURCES = ofm2opl.c ofm2opl.h -ofm2opl.c ofm2opl.h: ofm2opl-web2c -ofm2opl-web2c: $(web2c_depend) ofm2opl.p - $(web2c) ofm2opl - echo timestamp >$@ - touch ofm2opl.c ofm2opl.h -EXTRA_DIST += $(ofm2opl_sources) -ofm2opl_sources = omegaware/ofm2opl.web omegaware/ofm2opl.ch -ofm2opl.p: tangle$(EXEEXT) $(ofm2opl_sources) - $(ow_tangle) ofm2opl ofm2opl - -nodist_opl2ofm_SOURCES = opl2ofm.c opl2ofm.h -opl2ofm.c opl2ofm.h: opl2ofm-web2c -opl2ofm-web2c: $(web2c_depend) opl2ofm.p - $(web2c) opl2ofm - echo timestamp >$@ - touch opl2ofm.c opl2ofm.h -EXTRA_DIST += $(opl2ofm_sources) -opl2ofm_sources = omegaware/opl2ofm.web omegaware/opl2ofm.ch -opl2ofm.p: tangle$(EXEEXT) $(opl2ofm_sources) - $(ow_tangle) opl2ofm opl2ofm - nodist_otangle_SOURCES = otangle.c otangle.h otangle.c otangle.h: otangle-web2c otangle-web2c: $(web2c_depend) otangle.p @@ -76,28 +49,6 @@ otangle_sources = omegaware/otangle.web omegaware/otangle.ch otangle.p: tangle$(EXEEXT) $(otangle_sources) $(ow_tangle) otangle otangle -nodist_ovf2ovp_SOURCES = ovf2ovp.c ovf2ovp.h -ovf2ovp.c ovf2ovp.h: ovf2ovp-web2c -ovf2ovp-web2c: $(web2c_depend) ovf2ovp.p - $(web2c) ovf2ovp - echo timestamp >$@ - touch ovf2ovp.c ovf2ovp.h -EXTRA_DIST += $(ovf2ovp_sources) -ovf2ovp_sources = omegaware/ovf2ovp.web omegaware/ovf2ovp.ch -ovf2ovp.p: tangle$(EXEEXT) $(ovf2ovp_sources) - $(ow_tangle) ovf2ovp ovf2ovp - -nodist_ovp2ovf_SOURCES = ovp2ovf.c ovp2ovf.h -ovp2ovf.c ovp2ovf.h: ovp2ovf-web2c -ovp2ovf-web2c: $(web2c_depend) ovp2ovf.p - $(web2c) ovp2ovf - echo timestamp >$@ - touch ovp2ovf.c ovp2ovf.h -EXTRA_DIST += $(ovp2ovf_sources) -ovp2ovf_sources = omegaware/ovp2ovf.web omegaware/ovp2ovf.ch -ovp2ovf.p: tangle$(EXEEXT) $(ovp2ovf_sources) - $(ow_tangle) ovp2ovf ovp2ovf - ## Tests ## EXTRA_DIST += omegaware/otangle.test diff --git a/Build/source/texk/web2c/omegaware/ofm2opl.ch b/Build/source/texk/web2c/omegaware/ofm2opl.ch deleted file mode 100644 index 4b99c98d152..00000000000 --- a/Build/source/texk/web2c/omegaware/ofm2opl.ch +++ /dev/null @@ -1,461 +0,0 @@ -% -% This file is part of the Omega project, which -% is based in the web2c distribution of TeX. -% -% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous -% applies only to the changes to the original tftopl.ch. -% -% tftopl.ch for C compilation with web2c. -% -% 04/04/83 (PC) Original version, made to work with version 1.0 of TFtoPL, -% released with version 0.96 of TeX in February, 1983. -% 04/16/83 (PC) Brought up to version 1.0 released with version 0.97 of TeX -% in April, 1983. -% 06/30/83 (HWT) Revised changefile format, for use with version 1.7 Tangle. -% 07/28/83 (HWT) Brought up to version 2 -% 11/21/83 (HWT) Brought up to version 2.1 -% 03/24/84 (HWT) Brought up to version 2.2 -% 07/12/84 (HWT) Brought up to version 2.3 -% 07/05/87 (ETM) Brought up to version 2.5 -% 03/22/88 (ETM) Converted for use with WEB to C. -% 11/30/89 (KB) Version 3. -% 01/16/90 (SR) Version 3.1. -% (more recent changes in the ChangeLog) - -@x [0] WEAVE: print changes only. -\pageno=\contentspagenumber \advance\pageno by 1 -@y -\pageno=\contentspagenumber \advance\pageno by 1 -%\let\maybe=\iffalse -%\def\title{TF\lowercase{to}PL changes for C} -@z - -% [2] Fix files in program statement. We need to tell web2c about one -% special variable. Perhaps it would be better to allow @define's -% anywhere in a source file, but that seemed just as painful as this. -@x -@p program OFM2OPL(@!tfm_file,@!pl_file,@!output); -@y -@p -{Tangle doesn't recognize @@ when it's right after the \.=.} -@\@= @@define var tfm;@>@\ -program OFM2OPL(@!tfm_file,@!pl_file,@!output); -@z - -@x [still 2] Don't print banner until later (and unless verbose). -procedure initialize; {this procedure gets things started properly} - begin print_ln(banner);@/ -@y -@<Define |parse_arguments|@> -procedure initialize; {this procedure gets things started properly} - begin - kpse_set_progname (argv[0]); - kpse_init_prog ('OFM2OPL', 0, nil, nil); - {We |xrealloc| when we know how big the file is. The 1000 comes - from the negative lower bound.} - tfm_file_array := cast_to_byte_pointer (xmalloc (2000000)); - parse_arguments; -@z - -%@x [5] Increase sizes to match vptovf. -%@!tfm_size=30000; {maximum length of |tfm| data, in bytes} -%@!lig_size=5000; {maximum length of |lig_kern| program, in words} -%@!hash_size=5003; {preferably a prime number, a bit larger than the number -% of character pairs in lig/kern steps} -%@y -%@!tfm_size=40000; {maximum length of |tfm| data, in bytes} -%@!lig_size=8000; {maximum length of |lig_kern| program, in words ($<2^{15}$)} -%@!hash_size=8009; {preferably a prime number, a bit larger than the number -% of character pairs in lig/kern steps} -%@z - -@x [7] Open the TFM file. -@ On some systems you may have to do something special to read a -packed file of bytes. For example, the following code didn't work -when it was first tried at Stanford, because packed files have to be -opened with a special switch setting on the \PASCAL\ that was used. -@^system dependencies@> - -@<Set init...@>= -reset(tfm_file); -@y -@ On some systems you may have to do something special to read a -packed file of bytes. With C under Unix, we just open the file by name -and read characters from it. - -@<Set init...@>= -tfm_file := kpse_open_file (tfm_name, kpse_ofm_format); -if verbose then begin - print (banner); - print_ln (version_string); -end; -@z - -@x [17] Open the PL file. -@!pl_file:text; - -@ @<Set init...@>= -rewrite(pl_file); -@y -@!pl_file:text; - -@ If an explicit filename isn't given, we write to |stdout|. - -@<Set init...@>= -if optind + 1 = argc then begin - pl_file := stdout; -end else begin - pl_name := extend_filename (cmdline (optind + 1), 'opl'); - rewrite (pl_file, pl_name); -end; -@z - -@x [18,19] Make |tfm| be dynamically allocated, and rename `index'. -@<Types...@>= -@!byte=0..255; {unsigned eight-bit quantity} -@!index=-1000..tfm_size; {address of a byte in |tfm|} -@!char_type=0..65535; -@!xchar_type=0..65536; -@!xxchar_type=0..65537; -@!xxxchar_type=0..65538; - -@ -@<Glob...@>= -@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here} -@y -@d index == index_type - -@<Types...@>= -@!byte=0..255; {unsigned eight-bit quantity} -@!index=integer; {address of a byte in |tfm|} -@!char_type=0..65535; -@!xchar_type=0..65536; -@!xxchar_type=0..65537; -@!xxxchar_type=0..65538; - -@ CHECK OUT tfm array ranges. -@<Glob...@>= -{Kludge here to define |tfm| as a macro which takes care of the negative - lower bound. We've defined |tfm| for the benefit of web2c above.} -@=#define tfm (tfmfilearray + 1001);@>@\ -@!tfm_file_array: pointer_to_byte; {the input data all goes here} -@z - -@x [20] Send error output to stderr. -@d abort(#)==begin print_ln(#); - print_ln('Sorry, but I can''t go on; are you sure this is a OFM?'); -@y -@d abort(#)==begin write_ln(stderr, #); - write_ln(stderr, 'Sorry, but I can''t go on; are you sure this is a OFM?'); -@z - -@x [20] Allow arbitrarily large input files. -if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!'); -@.The file is bigger...@> -@y -{|tfm_file_array - := cast_to_byte_pointer (xrealloc (tfm_file_array, 4 * lf - 1 + 1108));|} -@z - -% [27, 28] Change strings to C char pointers. The Pascal strings are -% indexed starting at 1, so we pad with a blank. -@x -@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char; - {strings for output in the user's external character set} -@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char; - {handy string constants for |face| codes} -@y -@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: c_string; - {strings for output in the user's external character set} -@!ASCII_all: packed array[0..256] of char; -@!MBL_string,@!RI_string,@!RCE_string: c_string; - {handy string constants for |face| codes} -@z - -@x -ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ -ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ -ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/ -HEX:='0123456789ABCDEF';@/ -MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE'; -@y -ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ -ASCII_10:=' @@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ -ASCII_14:=' `abcdefghijklmnopqrstuvwxyz{|}~ ';@/ -HEX:=' 0123456789ABCDEF';@/ -strcpy (ASCII_all, ASCII_04); -strcat (ASCII_all, '@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'); -strcat (ASCII_all, '`abcdefghijklmnopqrstuvwxyz{|}~');@/ -MBL_string:=' MBL'; RI_string:=' RI '; RCE_string:=' RCE'; -@z - -% [38] How we output the character code depends on |charcode_format|. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x -begin if font_type>vanilla then - out_hex_char(c) -else if (c>="0")and(c<="9") then - out(' C ',c-"0":1) -else if (c>="A")and(c<="Z") then - out(' C ',ASCII_10[c-"A"+2]) -else if (c>="a")and(c<="z") then - out(' C ',ASCII_14[c-"a"+2]) -else out_hex_char(c); -@y -begin if (font_type > vanilla) or (charcode_format = charcode_hex) then - out_hex_char(c) -else if (charcode_format = charcode_ascii) and (c > " ") and (c <= "~") - and (c <> "(") and (c <> ")") then - out(' C ', ASCII_all[c - " " + 1]) -{default case, use hex} -else out_hex_char(c); -@z - -% [39] Don't output the face code as an integer. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x - out(MBL_string[1+(b mod 3)]); - out(RI_string[1+s]); - out(RCE_string[1+(b div 3)]); -@y - put_byte(MBL_string[1+(b mod 3)], pl_file); - put_byte(RI_string[1+s], pl_file); - put_byte(RCE_string[1+(b div 3)], pl_file); -@z - -@x [40] Force 32-bit constant arithmetic for 16-bit machines. -f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3]; -@y -f:=((tfm[k+1] mod 16)*intcast(@'400)+tfm[k+2])*@'400+tfm[k+3]; -@z - -% [78] No progress reports unless verbose. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x - incr(chars_on_line); - end; - if no_repeats(c)>0 then begin - print_hex(c); print('-'); print_hex(c+no_repeats(c)); - left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln; - end - else begin - print_hex(c); {progress report} - left; out('CHARACTER'); out_char(c); out_ln; - end; -@y - if verbose then incr(chars_on_line); - end; - if no_repeats(c)>0 then begin - if verbose then begin - print_hex(c); print('-'); print_hex(c+no_repeats(c)); - end; - left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln; - end - else begin - if verbose then print_hex(c); {progress report} - left; out('CHARACTER'); out_char(c); out_ln; - end; -@z - -% [89] Change the name of the variable `class', since AIX 3.1's <math.h> -% defines a function by that name. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x -@d pending=4 {$f(x,y)$ is being evaluated} -@y -@d pending=4 {$f(x,y)$ is being evaluated} - -@d class == class_var -@z - -% [90] Change name of the function `f'. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x - r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char); -@y - r:=f_fn(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char); -@z - -% [94] web2c can't handle these mutually recursive procedures. -% But let's do a fake definition of f here, so that it gets into web2c's -% symbol table. We also have to change the name, because there is also a -% variable named `f', and some C compilers can't deal with that. -@x -@p function f(@!h,@!x,@!y:index):index; forward;@t\2@> - {compute $f$ for arguments known to be in |hash[h]|} -@y -@p -ifdef('notdef') -function f_fn(@!h,@!x,@!y:index):index; begin end;@t\2@> - {compute $f$ for arguments known to be in |hash[h]|} -endif('notdef') -@z -@x -else eval:=f(h,x,y); -@y -else eval:=f_fn(h,x,y); -@z - -% [95] The real definition of f. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x -@p function f; -@y -@p function f_fn(@!h,@!x,@!y:index):index; -@z -@x -f:=lig_z[h]; -@y -f_fn:=lig_z[h]; -@z - -% [99] No final newline unless verbose. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x -do_characters; print_ln('.');@/ -@y -do_characters; if verbose then print_ln('.');@/ -@z - -@x [100] System-dependent changes. -This section should be replaced, if necessary, by changes to the program -that are necessary to make \.{TFtoPL} 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 printed 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@> -@y -Parse a Unix-style command line. - -@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0) - -@<Define |parse_arguments|@> = -procedure parse_arguments; -const n_options = 4; {Pascal won't count array lengths for us.} -var @!long_options: array[0..n_options] of getopt_struct; - @!getopt_return_val: integer; - @!option_index: c_int_type; - @!current_option: 0..n_options; -begin - @<Initialize the option variables@>; - @<Define the option table@>; - repeat - getopt_return_val := getopt_long_only (argc, argv, '', long_options, - address_of (option_index)); - if getopt_return_val = -1 then begin - {End of arguments; we exit the loop below.} ; - - end else if getopt_return_val = "?" then begin - usage ('ofm2opl'); - - end else if argument_is ('help') then begin - usage_help (OFM2OPL_HELP, nil); - - end else if argument_is ('version') then begin - print_version_and_exit - (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth', nil); - - end else if argument_is ('charcode-format') then begin - if strcmp (optarg, 'ascii') = 0 then - charcode_format := charcode_ascii - else if strcmp (optarg, 'hex') = 0 then - charcode_format := charcode_hex - else - write_ln (stderr, 'Bad character code format', optarg, '.'); - - end; {Else it was a flag; |getopt| has already done the assignment.} - until getopt_return_val = -1; - - {Now |optind| is the index of first non-option on the command line.} - if (optind + 1 <> argc) and (optind + 2 <> argc) then begin - write_ln (stderr, 'ofm2opl: Need one or two file arguments.'); - usage ('ofm2opl'); - end; - - tfm_name := cmdline (optind); -end; - -@ Here are the options we allow. The first is one of the standard GNU options. -@.-help@> - -@<Define the option...@> = -current_option := 0; -long_options[current_option].name := 'help'; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; -incr (current_option); - -@ Another of the standard options. -@.-version@> - -@<Define the option...@> = -long_options[current_option].name := 'version'; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; -incr (current_option); - -@ Print progress information? -@.-verbose@> - -@<Define the option...@> = -long_options[current_option].name := 'verbose'; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := address_of (verbose); -long_options[current_option].val := 1; -incr (current_option); - -@ -@<Glob...@> = -@!verbose: c_int_type; - -@ -@<Initialize the option...@> = -verbose := false; - -@ This option changes how we output character codes. -@.-charcode-format@> - -@<Define the option...@> = -long_options[current_option].name := 'charcode-format'; -long_options[current_option].has_arg := 1; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; -incr (current_option); - -@ We use an ``enumerated'' type to store the information. - -@<Type...@> = -@!charcode_format_type = charcode_ascii..charcode_default; - -@ -@<Const...@> = -@!charcode_ascii = 0; -@!charcode_hex = 1; -@!charcode_default = 2; - -@ -@<Global...@> = -@!charcode_format: charcode_format_type; - -@ It starts off as the default, which is hex for OFM2OPL. - -@<Initialize the option...@> = -charcode_format := charcode_default; - -@ An element with all zeros always ends the list. - -@<Define the option...@> = -long_options[current_option].name := 0; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; - -@ Global filenames. - -@<Global...@> = -@!tfm_name, @!pl_name:c_string; -@z diff --git a/Build/source/texk/web2c/omegaware/ofm2opl.web b/Build/source/texk/web2c/omegaware/ofm2opl.web deleted file mode 100644 index d18931fd3a9..00000000000 --- a/Build/source/texk/web2c/omegaware/ofm2opl.web +++ /dev/null @@ -1,2322 +0,0 @@ -% -% This file is part of the Omega project, which -% is based in the web2c distribution of TeX. -% -% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous -% applies only to the changes to the original tftopl.web. -% -% This program by D. E. Knuth is not copyrighted and can be used freely. -% Version 0 was implemented in January 1982. -% In February 1982 a new restriction on ligature steps was added. -% In June 1982 the routines were divided into smaller pieces for IBM people, -% and the result was designated "Version 1" in September 1982. -% Slight changes were made in October, 1982, for version 0.6 of TeX. -% Version 2 (July 1983) was released with TeX version 0.999. -% Version 2.1 (September 1983) changed TEXINFO to FONTDIMEN. -% Version 2.2 (February 1984) simplified decimal fraction output. -% Version 2.3 (May 1984) fixed a bug when lh=17. -% Version 2.4 (July 1984) fixed a bug involving unused ligature code. -% Version 2.5 (September 1985) updated the standard codingscheme names. -% Version 3 (October 1989) introduced new ligature capabilities. -% Version 3.1 (November 1989) renamed z[] to lig_z[] for better portability. - -% Version 1.0 of OFM2OPL (December 1995) allows one to read OFM files. - -% Here is TeX material that gets inserted after \input webmac -\def\hang{\hangindent 3em\indent\ignorespaces} -\font\ninerm=cmr9 -\let\mc=\ninerm % medium caps for names like SAIL -\def\PASCAL{Pascal} - -\def\(#1){} % this is used to make section names sort themselves better -\def\9#1{} % this is used for sort keys in the index - -\def\title{OFM2OPL} -\def\contentspagenumber{201} -\def\topofcontents{\null - \def\titlepage{F} % include headline on the contents page - \def\rheader{\mainfont\hfil \contentspagenumber} - \vfill - \centerline{\titlefont The {\ttitlefont OFM2OPL} processor} - \vskip 15pt - \centerline{(Version 1.11, February 2000)} - \vfill} -\def\botofcontents{\vfill - \centerline{\hsize 5in\baselineskip9pt - \vbox{\ninerm\noindent - The preparation of the original report - by D. E. Knuth - was supported in part by the National Science - Foundation under grants IST-8201926 and MCS-8300984, - and by the System Development Foundation. `\TeX' is a - trademark of the American Mathematical Society.}}} -\pageno=\contentspagenumber \advance\pageno by 1 - -@* Introduction. -The \.{OFM2OPL} utility program converts $\Omega$ and \TeX\ font -metric (``\.{TFM}'' and ``\.{OFM}'') files into equivalent -property-list (``\.{PL}'' and ``\.{OPL}'') files. It also -makes a thorough check of the given \.{TFM} or \.{OFM} file, -using essentially the same algorithm as \TeX\ or $\Omega$. Thus -if \TeX\ or $\Omega$ complains that a \.{TFM} or an \.{OFM} -file is ``bad,'' this program will pinpoint the source or sources of -badness. A \.{PL} or \.{OPL} file output by this program can be edited -with a normal text editor, and the result can be converted back to \.{TFM} -or \.{OFM} format using the companion program \.{OPLtoOFM}. - -The first \.{TFtoPL} program was designed by Leo Guibas in the summer of -1978. Contributions by Frank Liang, Doug Wyatt, and Lyle Ramshaw -also had a significant effect on the evolution of the present code. - -Extensions for an enhanced ligature mechanism were added by -D. E. Knuth in 1989. - -Extensions to handle extended font metric files (``\.{OFM}'') were -added by John Plaice in December 1995 and January 1996, resulting in -the new program \.{OFM2OPL}. In the following documentation, all -unchanged references to the \.{TFtoPL} program and to \.{TFM} and -\.{PL} files also apply to the \.{OFM2OPL} program and to \.{OFM} -and \.{OPL} files. - -The |banner| string defined here should be changed whenever \.{OFM2OPL} -gets modified. - -@d banner=='This is OFM2OPL, Version 1.11' - -@ This program is written entirely in standard \PASCAL, except that -it occasionally has lower case letters in strings that are output. -Such letters can be converted to upper case if necessary. The input is read -from |tfm_file|, and the output is written on |pl_file|; error messages and -other remarks are written on the |output| file, which the user may -choose to assign to the terminal if the system permits it. -@^system dependencies@> - -The term |print| is used instead of |write| when this program writes on -the |output| file, so that all such output can be easily deflected. - -@d print(#)==write(#) -@d print_ln(#)==write_ln(#) - -@p program OFM2OPL(@!tfm_file,@!pl_file,@!output); -label @<Labels in the outer block@>@/ -const @<Constants in the outer block@>@/ -type @<Types in the outer block@>@/ -var @<Globals in the outer block@>@/ -procedure initialize; {this procedure gets things started properly} - begin print_ln(banner);@/ - @<Set initial values@>@/ - end; - -@ If the program has to stop prematurely, it goes to the -`|final_end|'. - -@d final_end=9999 {label for the end of it all} - -@<Labels...@>=final_end; - -@ The following parameters can be changed at compile time to extend or -reduce \.{TFtoPL}'s capacity. - -@<Constants...@>= -@!tfm_size=2000000; {maximum length of |tfm| data, in bytes} -@!lig_size=800000; {maximum length of |lig_kern| program, in words} -@!hash_size=130003; {preferably a prime number, a bit larger than the number - of character pairs in lig/kern steps} -@!hash_mult=16007; {another prime} -@!max_char=65535; {the largest character number in a font} -@!xmax_char=65536; {|max_char|+1} -@!xxmax_char=65537;{|max_char|+2} -@!xmax_label=80001;{must be greater than |max_lig_steps|} -@!mem_size=262152; {|max_char|*4+8} - -@ Here are some macros for common programming idioms. - -@d incr(#) == #:=#+1 {increase a variable by unity} -@d decr(#) == #:=#-1 {decrease a variable by unity} -@d do_nothing == {empty statement} - -@* Font metric data. -The following description of \.{TFM} files is not sufficient for -\.{OFM} files. The additional documentation necessary for the -\.{OFM} files can be found in another file, such as the $\Omega$ -change files. - -The idea behind \.{TFM} files is that typesetting routines like \TeX\ -need a compact way to store the relevant information about several -dozen fonts, and computer centers need a compact way to store the -relevant information about several hundred fonts. \.{TFM} files are -compact, and most of the information they contain is highly relevant, -so they provide a solution to the problem. - -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 \TeX\ uses the -byte interpretation, and so does \.{TFtoPL}. Note that the bytes -are considered to be unsigned numbers. - -@<Glob...@>= -@!tfm_file:packed file of 0..255; - -@ On some systems you may have to do something special to read a -packed file of bytes. For example, the following code didn't work -when it was first tried at Stanford, because packed files have to be -opened with a special switch setting on the \PASCAL\ that was used. -@^system dependencies@> - -@<Set init...@>= -reset(tfm_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. - -@<Glob...@>= -@!ofm_level, -@!nco,@!ncw,@!npc,@!nki,@!nwi,@!nkf,@!nwf,@!nkr,@!nwr,@!nkg,@!nwg,@!nkp,@!nwp, -@!nkm,@!nwm,@!real_lf, -@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np,@!font_dir:integer; - {subfile sizes} -@!ofm_on:boolean; - -@ @<Set init...@>= -ofm_on:=false; ofm_level:=-1; lf:=0; lh:=0; -nco:=0; ncw:=0; npc:=0; bc:=0; ec:=0; nw:=0; nh:=0; nd:=0; ni:=0; -nl:=0; nk:=0; ne:=0; np:=0; -nki:=0; nwi:=0; nkf:=0; nwf:=0; -nkm:=0; nwm:=0; real_lf:=0; -nkr:=0; nwr:=0; nkg:=0; nwg:=0; -nkp:=0; nwp:=0; font_dir:=0; - -@ The rest of the \.{TFM} file may be regarded as a sequence of ten data -arrays having the informal specification -$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2} -\vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr -header&|[0..lh-1]stuff|\cr -char\_info&|[bc..ec]char_info_word|\cr -width&|[0..nw-1]fix_word|\cr -height&|[0..nh-1]fix_word|\cr -depth&|[0..nd-1]fix_word|\cr -italic&|[0..ni-1]fix_word|\cr -lig\_kern&|[0..nl-1]lig_kern_command|\cr -kern&|[0..nk-1]fix_word|\cr -exten&|[0..ne-1]extensible_recipe|\cr -param&|[1..np]fix_word|\cr}}$$ -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 one of -the |fix_word| values will 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, -and for \.{TFM} files to be used with Xerox printing software it must -contain at least 18 words, allocated as described below. When different -kinds of devices need to be interfaced, it may be necessary to add further -words to the header block. - -\yskip\hang|header[0]| is a 32-bit check sum that \TeX\ will copy into the -\.{DVI} output file whenever it uses the font. Later on when the \.{DVI} -file is printed, possibly on another computer, the actual font that gets -used is supposed to have a check sum that agrees with the one in the -\.{TFM} file used by \TeX. In this way, users will be warned about -potential incompatibilities. (However, if the check sum is zero in either -the font file or the \.{TFM} file, no check is made.) 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 (7227 \TeX\ points = 254 cm). 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]|, one \.{em} or \.{\\quad}, 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@> - -\yskip\hang|header[2..11]|, if present, contains 40 bytes that identify -the character coding scheme. The first byte, which must be between 0 and -39, is the number of subsequent ASCII bytes actually relevant in this -string, which is intended to specify what character-code-to-symbol -convention is present in the font. Examples are \.{ASCII} for standard -ASCII, \.{TeX text} for fonts like \.{cmr10} and \.{cmti9}, \.{TeX math -extension} for \.{cmex10}, \.{XEROX text} for Xerox fonts, \.{GRAPHIC} for -special-purpose non-alphabetic fonts, \.{UNSPECIFIED} for the default case -when there is no information. Parentheses should not appear in this name. -(Such a string is said to be in {\mc BCPL} format.) -@^coding scheme@> - -\yskip\hang|header[12..16]|, if present, contains 20 bytes that name the -font family (e.g., \.{CMR} or \.{HELVETICA}), in {\mc BCPL} format. -This field is also known as the ``font identifier.'' -@^family name@> -@^font identifier@> - -\yskip\hang|header[17]|, if present, contains a first byte called the -|seven_bit_safe_flag|, then two bytes that are ignored, and a fourth byte -called the |face|. If the value of the fourth byte is less than 18, it has -the following interpretation as a ``weight, slope, and expansion'': Add 0 -or 2 or 4 (for medium or bold or light) to 0 or 1 (for roman or italic) to -0 or 6 or 12 (for regular or condensed or extended). For example, 13 is -0+1+12, so it represents medium italic extended. A three-letter code -(e.g., \.{MIE}) can be used for such |face| data. - -\yskip\hang|header[18..@twhatever@>]| might also be present; the individual -words are simply called |header[18]|, |header[19]|, etc., at the moment. - -@ Next comes the |char_info| array, which contains one |char_info_word| -per character. Each |char_info_word| 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 |lig_kern[remainder]|.\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 - -@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 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). - -Notice that if $a=0$ and $b=1$, the current character is unchanged; if -$a=b$ and $c=1$, the current character is changed but the next character is -unchanged. \.{TFtoPL} will check to see that infinite loops are avoided. - -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 have -|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} - -@ 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. - - -@ 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's the only |fix_word| other than the design size itself that is -not scaled by the design size. - -\hang|param[2]=space| is the normal spacing between words in text. -Note that character |" "| 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 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. - -When the character coding scheme is \.{TeX math symbols}, the font is -supposed to have 15 additional parameters called |num1|, |num2|, |num3|, -|denom1|, |denom2|, |sup1|, |sup2|, |sup3|, |sub1|, |sub2|, |supdrop|, -|subdrop|, |delim1|, |delim2|, and |axis_height|, respectively. When the -character coding scheme is \.{TeX math extension}, the font is supposed to -have six additional parameters called |default_rule_thickness| and -|big_op_spacing1| through |big_op_spacing5|. - -@ So that is what \.{TFM} files hold. The next question is, ``What about -\.{PL} files?'' A complete answer to that question appears in the -documentation of the companion program, \.{PLtoTF}, so it will not -be repeated here. Suffice it to say that a \.{PL} file is an ordinary -\PASCAL\ text file, and that the output of \.{TFtoPL} uses only a -subset of the possible constructions that might appear in a \.{PL} file. -Furthermore, hardly anybody really wants to look at the formal -definition of \.{PL} format, because it is almost self-explanatory when -you see an example or two. - -@<Glob...@>= -@!pl_file:text; - -@ @<Set init...@>= -rewrite(pl_file); - -@* Unpacked representation. -The first thing \.{TFtoPL} does is read the entire |tfm_file| into an array of -bytes, |tfm[0..(4*lf-1)]|. - -@<Types...@>= -@!byte=0..255; {unsigned eight-bit quantity} -@!index=-1000..tfm_size; {address of a byte in |tfm|} -@!char_type=0..65535; -@!xchar_type=0..65536; -@!xxchar_type=0..65537; -@!xxxchar_type=0..65538; - -@ -@<Glob...@>= -@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here} - {the negative addresses avoid range checks for invalid characters} -@!top_char,@!top_width,@!top_height,@!top_depth,@!top_italic:integer; -@!start_ptr,@!check_sum,@!design_size,@!scheme,@!family,@!random_word:integer; -@!header_length,@!char_ptr,@!copies,@!j:integer; - -@ The input may, of course, be all screwed up and not a \.{TFM} file -at all. So we begin cautiously. - -@d abort(#)==begin print_ln(#); - print_ln('Sorry, but I can''t go on; are you sure this is a OFM?'); - goto final_end; - end - -@<Read the whole input file@>= -read(tfm_file,tfm[0]); -if tfm[0]>127 then abort('The first byte of the input file exceeds 127!'); -@.The first byte...@> -if eof(tfm_file) then abort('The input file is only one byte long!'); -@.The input...one byte long@> -read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1]; -if lf=0 then begin - for i:=2 to 7 do - begin - if eof(tfm_file) - then abort('The input file is too short to designate its length!'); - read(tfm_file, tfm[i]); - end; - ofm_on := true; ofm_level := tfm[2]*@"100+tfm[3]; - if tfm[4]>127 then abort('The fifth byte of the input file exceeds 127!'); - lf := tfm[4]*@"1000000 + tfm[5]*@"10000 + tfm[6]*@"100 + tfm[7]; -end -else -begin - ofm_on := false; -end; -case ofm_level of --1: begin start_ptr:=2; check_sum:=24; end; - 0: begin start_ptr:=8; check_sum:=56; end; - 1: begin start_ptr:=8; check_sum:=116; end; -end; -design_size:=check_sum+4; -scheme:=design_size+4; -family:=scheme+40; -random_word:=family+20; -if lf=0 then - abort('The file claims to have length zero, but that''s impossible!'); -@.The file claims...@> -if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!'); -@.The file is bigger...@> -for tfm_ptr:=start_ptr to 4*lf-1 do - begin if eof(tfm_file) then - abort('The file has fewer bytes than it claims!'); -@.The file has fewer bytes...@> - read(tfm_file,tfm[tfm_ptr]); - end; -if not eof(tfm_file) then - begin print_ln('There''s some extra junk at the end of the OFM file,'); -@.There's some extra junk...@> - print_ln('but I''ll proceed as if it weren''t there.'); - end - -@ After the file has been read successfully, we look at the subfile sizes -to see if they check out. - -@d eval_two_bytes(#)==begin if tfm[tfm_ptr]>127 then - abort('One of the subfile sizes is negative!'); -@.One of the subfile sizes...@> - #:=tfm[tfm_ptr]*@'400+tfm[tfm_ptr+1]; - tfm_ptr:=tfm_ptr+2; - end -@d eval_four_bytes(#)==begin if tfm[tfm_ptr]>127 then - abort('One of the subfile sizes is negative!'); -@.One of the subfile sizes...@> - #:=tfm[tfm_ptr]*@"1000000+tfm[tfm_ptr+1]*@"10000+ - tfm[tfm_ptr+2]*@"100+tfm[tfm_ptr+3]; - tfm_ptr:=tfm_ptr+4; - end - -@<Set subfile sizes |lh|, |bc|, \dots, |np|@>= -begin -if not ofm_on then begin - tfm_ptr:=2; - eval_two_bytes(lh); - eval_two_bytes(bc); - eval_two_bytes(ec); - eval_two_bytes(nw); - eval_two_bytes(nh); - eval_two_bytes(nd); - eval_two_bytes(ni); - eval_two_bytes(nl); - eval_two_bytes(nk); - eval_two_bytes(ne); - eval_two_bytes(np); - ncw:=(ec-bc+1); - header_length:=6; - top_char:=255; - top_width:=255; - top_height:=15; - top_depth:=15; - top_italic:=63; - end -else begin - tfm_ptr:=8; - eval_four_bytes(lh); - eval_four_bytes(bc); - eval_four_bytes(ec); - eval_four_bytes(nw); - eval_four_bytes(nh); - eval_four_bytes(nd); - eval_four_bytes(ni); - eval_four_bytes(nl); - eval_four_bytes(nk); - eval_four_bytes(ne); - eval_four_bytes(np); - eval_four_bytes(font_dir); - top_char:=65535; - top_width:=65535; - top_height:=255; - top_depth:=255; - top_italic:=255; - if ofm_level=0 then begin - header_length:=14; - ncw:=2*(ec-bc+1); - end - else begin - header_length:=29; - eval_four_bytes(nco); - eval_four_bytes(ncw); - eval_four_bytes(npc); - eval_four_bytes(nki); {Kinds of font ivalues} - eval_four_bytes(nwi); {Words of font ivalues} - eval_four_bytes(nkf); {Kinds of font fvalues} - eval_four_bytes(nwf); {Words of font fvalues} - eval_four_bytes(nkm); {Kinds of font mvalues} - eval_four_bytes(nwm); {Words of font mvalues} - eval_four_bytes(nkr); {Kinds of font rules} - eval_four_bytes(nwr); {Words of font rules} - eval_four_bytes(nkg); {Kinds of font glues} - eval_four_bytes(nwg); {Words of font glues} - eval_four_bytes(nkp); {Kinds of font penalties} - eval_four_bytes(nwp); {Words of font penalties} - end; - end; -if lf<>(header_length+lh+ncw+nw+nh+nd+ni+2*nl+nk+2*ne+np+ - nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp) then - abort('Subfile sizes don''t add up to the stated total!'); -@.Subfile sizes don't add up...@> -if lh<2 then abort('The header length is only ',lh:1,'!'); -@.The header length...@> -if (2*nl)>(4*lig_size) then - abort('The lig/kern program is longer than I can handle!'); -@.The lig/kern program...@> -if (bc>ec+1)or(ec>top_char) then abort('The character code range ', -@.The character code range...@> - bc:1,'..',ec:1,'is illegal!'); -if ec>max_char then - abort('Character ',ec:1,'is too large. Ask a wizard to enlarge me.'); -if (nw=0)or(nh=0)or(nd=0)or(ni=0) then - abort('Incomplete subfiles for character dimensions!'); -@.Incomplete subfiles...@> -if ne>(top_char+1) then abort('There are ',ne:1,' extensible recipes!'); -@.There are ... recipes@> -end - -@ Once the input data successfully passes these basic checks, -\.{TFtoPL} believes that it is a \.{TFM} file, and the conversion -to \.{PL} format will take place. Access to the various subfiles -is facilitated by computing the following base addresses. For example, -the |char_info| for character |c| in a \.{TFM} file will start in location -|4*(char_base+c)| of the |tfm| array. - -@<Globals...@>= -@!ivalues_start,@!fvalues_start,@!mvalues_start, -@!rules_start,@!glues_start,@!penalties_start: -integer; -@!ivalues_base,@!fvalues_base,@!mvalues_base, -@!rules_base,@!glues_base,@!penalties_base: -integer; -@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base: integer; -@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer; - {base addresses for the subfiles} -@!char_start:array [0..max_char] of integer; -@!bytes_per_entry:integer; - -@ @<Compute the base addresses@>= -begin -ivalues_start:=header_length+lh; -fvalues_start:=ivalues_start+nki; -mvalues_start:=fvalues_start+nkf; -rules_start:=mvalues_start+nkm; -glues_start:=rules_start+nkr; -penalties_start:=glues_start+nkg; -ivalues_base:=penalties_start+nkp; -fvalues_base:=ivalues_base+nwi; -mvalues_base:=fvalues_base+nwf; -rules_base:=mvalues_base+nwm; -glues_base:=rules_base+nwr; -penalties_base:=glues_base+nwg; -char_base:=penalties_base+nwp; -bytes_per_entry:=(12 + 2*npc) div 4 * 4; -if not ofm_on then begin - for i:=bc to ec do begin - char_start[i]:=4*char_base+4*(i-bc); - end; - end -else if ofm_level=0 then begin - for i:=bc to ec do begin - char_start[i]:=4*char_base+8*(i-bc); - end; - end -else begin - char_ptr:=4*char_base; - i:=bc; - while i<=ec do begin - copies:=1+256*tfm[char_ptr+8]+tfm[char_ptr+9]; - for j:=1 to copies do begin - char_start[i]:=char_ptr; - i:=i+1; - end; - char_ptr:=char_ptr + bytes_per_entry; - end; - if char_ptr<>(4*(char_base+ncw)) then - abort('Length of char info table does not correspond to specification'); - end; -width_base:=char_base+ncw; -height_base:=width_base+nw; -depth_base:=height_base+nh; -italic_base:=depth_base+nd; -lig_kern_base:=italic_base+ni; -kern_base:=lig_kern_base+2*nl; -exten_base:=kern_base+nk; -param_base:=exten_base+2*ne-1; -end - -@ Of course we want to define macros that suppress the detail of how the -font information is actually encoded. Each word will be referred to by -the |tfm| index of its first byte. For example, if |c| is a character -code between |bc| and |ec|, then |tfm[char_info(c)]| will be the -first byte of its |char_info|, i.e., the |width_index|; furthermore -|width(c)| will point to the |fix_word| for |c|'s width. - -@d char_info(#)==char_start[#] -@d nonexistent(#)==((#<bc)or(#>ec)or(width_index(#)=0)) -@d width(#)==4*(width_base+width_index(#)) -@d height(#)==4*(height_base+height_index(#)) -@d depth(#)==4*(depth_base+depth_index(#)) -@d italic(#)==4*(italic_base+italic_index(#)) -@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character} -@d param(#)==4*(param_base+#) {likewise} - -@p function width_index(c:char_type):integer; -begin if not ofm_on then - width_index:=tfm[char_info(c)] -else - width_index:=256*tfm[char_info(c)]+tfm[char_info(c)+1]; -end; - -function height_index(c:char_type):integer; -begin if not ofm_on then - height_index:=tfm[char_info(c)+1] div 16 -else - height_index:=tfm[char_info(c)+2]; -end; - -function depth_index(c:char_type):integer; -begin if not ofm_on then - depth_index:=tfm[char_info(c)+1] mod 16 -else - depth_index:=tfm[char_info(c)+3]; -end; - -function italic_index(c:char_type):integer; -begin if not ofm_on then - italic_index:=tfm[char_info(c)+2] div 4 -else if ofm_level=0 then - italic_index:=tfm[char_info(c)+4]*64 + tfm[char_info(c)+5] div 4 -else - italic_index:=tfm[char_info(c)+4]; -end; - -function tag(c:char_type):integer; -begin if not ofm_on then - tag:=tfm[char_info(c)+2] mod 4 -else - tag:=tfm[char_info(c)+5] mod 4; -end; - -procedure set_no_tag(c:char_type); -begin if not ofm_on then - tfm[char_info(c)+2] := (tfm[char_info(c)+2] div 64)*64 + no_tag -else - tfm[char_info(c)+5] := (tfm[char_info(c)+5] div 64)*64 + no_tag; -end; - -function ctag(c:char_type):boolean; -begin if not (ofm_level=1) then - ctag:=false -else - ctag:=tfm[char_info(c)+5] div 4 mod 2; -end; - -procedure set_no_ctag(c:char_type); -begin if not (ofm_level=1) then - tfm[char_info(c)+5] := - tfm[char_info(c)+5] div 8 * 8 + tfm[char_info(c)+5] mod 4; -end; - -function no_repeats(c:char_type):integer; -begin if ofm_level<=0 then - no_repeats:=0 -else - no_repeats:=256*tfm[char_info(c)+8]+tfm[char_info(c)+9]; -end; - -function char_param(c:char_type; i:integer):integer; -begin - char_param:=256*tfm[char_info(c)+2*i+10]+tfm[char_info(c)+2*i+11]; -end; - -function rremainder(c:char_type):integer; -begin if not ofm_on then - rremainder:=tfm[char_info(c)+3] -else - rremainder:=256*tfm[char_info(c)+6]+tfm[char_info(c)+7]; -end; - -function lig_step(c:char_type):integer; -begin if not ofm_on then - lig_step:=4*(lig_kern_base+c) -else - lig_step:=4*(lig_kern_base+2*c); -end; - -function exten(c:char_type):integer; -begin if not ofm_on then - exten:=4*(exten_base+rremainder(c)) -else - exten:=4*(exten_base+2*rremainder(c)); -end; - -function l_skip_byte(c:integer):integer; -begin if not ofm_on then - l_skip_byte:=tfm[c] -else - l_skip_byte:=256*tfm[c]+tfm[c+1]; -end; - -procedure set_l_skip_byte(c:integer; newc:integer); -begin if not ofm_on then - tfm[c]:=newc -else begin - tfm[c]:=newc div 256; - tfm[c+1]:=newc mod 256 - end -end; - -function l_next_char(c:integer):integer; -begin if not ofm_on then - l_next_char:=tfm[c+1] -else - l_next_char:=256*tfm[c+2]+tfm[c+3]; -end; - -procedure set_l_next_char(c:integer; newc:char_type); -begin if not ofm_on then - tfm[c+1]:=newc -else begin - tfm[c+2]:=newc div 256; - tfm[c+3]:=newc mod 256 - end -end; - -function l_op_byte(c:integer):integer; -begin if not ofm_on then - l_op_byte:=tfm[c+2] -else - l_op_byte:=256*tfm[c+4]+tfm[c+5]; -end; - -procedure set_l_op_byte(c:integer; newc:integer); -begin if not ofm_on then - tfm[c+2]:=newc -else begin - tfm[c+2]:=newc div 256; - tfm[c+3]:=newc mod 256 - end -end; - -function l_remainder(c:integer):integer; -begin if not ofm_on then - l_remainder:=tfm[c+3] -else - l_remainder:=256*tfm[c+6]+tfm[c+7]; -end; - -procedure set_l_remainder(c:integer; newc:char_type); -begin if not ofm_on then - tfm[c+3]:=newc -else begin - tfm[c+6]:=newc div 256; - tfm[c+7]:=newc mod 256 - end -end; - -@ One of the things we would like to do is take cognizance of fonts whose -character coding scheme is \.{TeX math symbols} or \.{TeX math extension}; -we will set the |font_type| variable to one of the three choices -|vanilla|, |mathsy|, or |mathex|. - -@d vanilla=0 {not a special scheme} -@d mathsy=1 {\.{TeX math symbols} scheme} -@d mathex=2 {\.{TeX math extension} scheme} - -@<Glob...@>= -@!font_type:vanilla..mathex; {is this font special?} - -@* Basic output subroutines. -Let us now define some procedures that will reduce the rest of \.{TFtoPL}'s -work to a triviality. - -First of all, it is convenient to have an abbreviation for output to the -\.{PL} file: - -@d out(#)==write(pl_file,#) - -@ In order to stick to standard \PASCAL, we use three strings called -|ASCII_04|, |ASCII_10|, and |ASCII_14|, in terms of which we can do the -appropriate conversion of ASCII codes. Three other little strings are -used to produce |face| codes like \.{MIE}. - -@<Glob...@>= -@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char; - {strings for output in the user's external character set} -@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char; - {handy string constants for |face| codes} - -@ @<Set init...@>= -ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ -ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ -ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/ -HEX:='0123456789ABCDEF';@/ -MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE'; - -@ The array |dig| will hold a sequence of digits to be output. - -@<Glob...@>= -@!dig:array[0..32] of integer; - -@ Here, in fact, are two procedures that output -|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$. - -@p procedure out_digs(j:integer); {outputs |j| digits} -begin repeat decr(j); out(HEX[1+dig[j]]); - until j=0; -end; -@# -procedure print_digs(j:integer); {prints |j| digits} -begin repeat decr(j); print(HEX[1+dig[j]]); - until j=0; -end; - -@ The |print_number| procedure indicates how |print_digs| can be used. -This procedure can print in octal, decimal or hex notation. - -@d print_hex(#)==print_number(#,16) -@d print_octal(#)==print_number(#,8) -@d print_decimal(#)==print_number(#,10) - -@p procedure print_number(c:integer; form:integer); {prints value of |c|} -var j:0..32; {index into |dig|} -begin -j:=0; -if (c<0) then begin - print_ln('Internal error: print_number (negative value)'); - c:=0; - end; -if form=8 then - print('''') {an apostrophe indicates the octal notation} -else if form=16 then - print('"') { a double apostrophe indicates the hexadecimal notation} -else if form<>10 then begin - print_ln('Internal error: print_number (form)'); - form:=16; - end; -while (c>0) or (j=0) do begin - dig[j]:=c mod form; c:=c div form; - j:=j+1; - end; -print_digs(j); -end; - -@ A \.{PL} file has nested parentheses, and we want to format the output -so that its structure is clear. The |level| variable keeps track of the -depth of nesting. - -@<Glob...@>= -@!level:0..5; - -@ @<Set init...@>= -level:=0; - -@ Three simple procedures suffice to produce the desired structure in the -output. - -@p procedure out_ln; {finishes one line, indents the next} -var l:0..5; -begin write_ln(pl_file); -for l:=1 to level do out(' '); -end; -@# -procedure left; {outputs a left parenthesis} -begin incr(level); out('('); -end; -@# -procedure right; {outputs a right parenthesis and finishes a line} -begin decr(level); out(')'); out_ln; -end; - -@ The value associated with a property can be output in a variety of -ways. For example, we might want to output a {\mc BCPL} string that -begins in |tfm[k]|: - -@p procedure out_BCPL(@!k:index); {outputs a string, preceded by a blank space} -var l:0..39; {the number of bytes remaining} -begin out(' '); l:=tfm[k]; -while l>0 do - begin incr(k); decr(l); - case tfm[k] div @'40 of - 1: out(ASCII_04[1+(tfm[k] mod @'40)]); - 2: out(ASCII_10[1+(tfm[k] mod @'40)]); - 3: out(ASCII_14[1+(tfm[k] mod @'40)]); - end; - end; -end; - -@ The property value might also be a sequence of |l| bytes, beginning -in |tfm[k]|, that we would like to output in hex notation. -The following procedure assumes that |l<=4|, but larger values of |l| -could be handled easily by enlarging the |dig| array and increasing -the upper bounds on |b| and |j|. - -@d out_octal_number(#)==out_number(#,8) -@d out_decimal_number(#)==out_number(#,10) -@d out_hex_number(#)==out_number(#,16) -@d out_dec(#)==out_decimal_number(#) -@d out_hex_char(#)==out_hex_number(#) - -@p procedure out_number(c:integer; form:integer); {outputs value of |c|} -var j:0..32; {index into |dig|} -begin -j:=0; -if (c<0) then begin - print_ln('Internal error: print_number (negative value)'); - c:=0; - end; -if form=8 then - out(' O ') -else if form=10 then - out(' D ') -else if form=16 then - out(' H ') -else begin - print_ln('Internal error: print_number (form)'); - form:=16; - out(' H ') - end; -while (c>0) or (j=0) do begin - dig[j]:=c mod form; c:=c div form; - j:=j+1; - end; -out_digs(j); -end; -@# -procedure out_hex(@!k,@!l:index); - {outputs |l| bytes in hex} -var a:0..@"7FFFFFFF; {accumulator for bits not yet output} -@!b:0..32; {the number of significant bits in |a|} -@!j:0..11; {the number of digits of output} -begin -out(' H '); -a:=0; b:=0; j:=0; -while l>0 do @<Reduce \(1)|l| by one, preserving the invariants@>; -while (a>0)or(j=0) do begin - dig[j]:=a mod 16; a:=a div 16; incr(j); - end; -out_digs(j); -end; - -@ @<Reduce \(1)|l|...@>= -begin decr(l); -if tfm[k+l]<>0 then begin - while b>3 do begin - dig[j]:=a mod 16; a:=a div 16; b:=b-4; incr(j); - end; - case b of - 0: a:=tfm[k+l]; - 1:a:=a+2*tfm[k+l]; - 2:a:=a+4*tfm[k+l]; - 3:a:=a+8*tfm[k+l]; - end; - end; -b:=b+8; -end - -@ The property value may be a character, which is output in hex -unless it is a letter or a digit. This procedure is the only place -where a lowercase letter will be output to the \.{PL} file. -@^system dependencies@> - -@p procedure out_char(@!c:integer); {outputs a character} -begin if font_type>vanilla then - out_hex_char(c) -else if (c>="0")and(c<="9") then - out(' C ',c-"0":1) -else if (c>="A")and(c<="Z") then - out(' C ',ASCII_10[c-"A"+2]) -else if (c>="a")and(c<="z") then - out(' C ',ASCII_14[c-"a"+2]) -else out_hex_char(c); -end; - -@ The property value might be a ``face'' byte, which is output in the -curious code mentioned earlier, provided that it is less than 18. - -@p procedure out_face(@!k:index); {outputs a |face|} -var s:0..1; {the slope} -@!b:0..8; {the weight and expansion} -begin if tfm[k]>=18 then out_hex(k,1) -else begin out(' F '); {specify face-code format} - s:=tfm[k] mod 2; b:=tfm[k] div 2; - out(MBL_string[1+(b mod 3)]); - out(RI_string[1+s]); - out(RCE_string[1+(b div 3)]); - end; -end; - -@ And finally, the value might be a |fix_word|, which is output in -decimal notation with just enough decimal places for \.{PLtoTF} -to recover every bit of the given |fix_word|. - -All of the numbers involved in the intermediate calculations of -this procedure will be nonnegative and less than $10\cdot2^{24}$. - -@p procedure out_fix(@!k:index); {outputs a |fix_word|} -var a:0..@'7777; {accumulator for the integer part} -@!f:integer; {accumulator for the fraction part} -@!j:0..12; {index into |dig|} -@!delta:integer; {amount if allowable inaccuracy} -begin out(' R '); {specify real format} -a:=(tfm[k]*16)+(tfm[k+1] div 16); -f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3]; -if a>@'3777 then @<Reduce \(2)negative to positive@>; -@<Output the integer part, |a|, in decimal notation@>; -@<Output the fraction part, $|f|/2^{20}$, in decimal notation@>; -end; - -@ The following code outputs at least one digit even if |a=0|. - -@<Output the integer...@>= -begin j:=0; -repeat dig[j]:=a mod 10; a:=a div 10; incr(j); -until a=0; -out_digs(j); -end - -@ And the following code outputs at least one digit to the right -of the decimal point. - -@<Output the fraction...@>= -begin out('.'); f:=10*f+5; delta:=10; -repeat if delta>@'4000000 then f:=f+@'2000000-(delta div 2); -out(f div @'4000000:1); f:=10*(f mod @'4000000); delta:=delta*10; -until f<=delta; -end; - -@ @<Reduce \(2)negative to positive@>= -begin out('-'); a:=@'10000-a; -if f>0 then begin - f:=@'4000000-f; decr(a); - end; -end - -@* Doing it. -\TeX\ checks the information of a \.{TFM} file for validity as the -file is being read in, so that no further checks will be needed when -typesetting is going on. And when it finds something wrong, it justs -calls the file ``bad,'' without identifying the nature of the problem, -since \.{TFM} files are supposed to be good almost all of the time. - -Of course, a bad file shows up every now and again, and that's where -\.{TFtoPL} comes in. This program wants to catch at least as many errors as -\TeX\ does, and to give informative error messages besides. -All of the errors are corrected, so that the \.{PL} output will -be correct (unless, of course, the \.{TFM} file was so loused up -that no attempt is being made to fathom it). - -@ Just before each character is processed, its code is printed in hex -notation. Up to eight such codes appear on a line; so we have a variable -to keep track of how many are currently there. We also keep track of -whether or not any errors have had to be corrected. - -@<Glob...@>= -@!chars_on_line:0..8; {the number of characters printed on the current line} -@!perfect:boolean; {was the file free of errors?} - -@ @<Set init...@>= -chars_on_line:=0;@/ -perfect:=true; {innocent until proved guilty} - -@ Error messages are given with the help of the |bad| and |range_error| -and |bad_char| macros: - -@d bad(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' '); - chars_on_line:=0; print_ln('Bad OFM file: ',#); - end -@.Bad OFM file@> -@d range_error(#)==begin perfect:=false; print_ln(' '); - print(#,' index for character '); - print_hex(c); print_ln(' is too large;'); - print_ln('so I reset it to zero.'); - end -@d bad_char_tail(#)==print_hex(#); print_ln('.'); - end -@d bad_char(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' '); - chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character '); - bad_char_tail -@d correct_bad_char_tail(#)==#(k,0) - end -@d correct_bad_char_middle(#)==print_hex(#(k)); print_ln('.'); - correct_bad_char_tail -@d correct_bad_char(#)== begin perfect:=false; - if chars_on_line>0 then print_ln(' '); - chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character '); - correct_bad_char_middle - -@<Glob...@>= -@!i:integer; {an index to words of a subfile} -@!c:xchar_type; {a random character} -@!d:0..3; {byte number in a word} -@!k:index; {a random index} -@!r:0..65535; {a random two-byte value} -@!count:0..127; {for when we need to enumerate a small set} - -@ There are a lot of simple things to do, and they have to be done one -at a time, so we might as well get down to business. The first things -that \.{TFtoPL} will put into the \.{PL} file appear in the header part. - -@<Do the header@>= -begin -case ofm_level of -0: begin out('(OFMLEVEL H 0)'); out_ln; end; -1: begin out('(OFMLEVEL H 1)'); out_ln; end; -end; -if ofm_on then begin - left; - if font_dir<=7 then out('FONTDIR') - else out('NFONTDIR'); - case font_dir mod 8 of - 0: out(' TL'); - 1: out(' LT'); - 2: out(' TR'); - 3: out(' LB'); - 4: out(' BL'); - 5: out(' RT'); - 6: out(' BR'); - 7: out(' RB'); - end; - right - end; -font_type:=vanilla; -if lh>=12 then begin - @<Set the true |font_type|@>; - if lh>=17 then begin - @<Output the family name@>; - if lh>=18 then @<Output the rest of the header@>; - end; - @<Output the character coding scheme@>; - end; -@<Output the design size@>; -@<Output the check sum@>; -@<Output the |seven_bit_safe_flag|@>; -end - -@ @<Output the check sum@>= -left; out('CHECKSUM'); out_hex(check_sum,4); -right - -@ Incorrect design sizes are changed to 10 points. - -@d bad_design(#)==begin bad('Design size ',#,'!'); -@.Design size wrong@> - print_ln('I''ve set it to 10 points.'); - out(' D 10'); - end - -@ @<Output the design size@>= -left; out('DESIGNSIZE'); -if tfm[design_size]>127 then bad_design('negative') -else if (tfm[design_size]=0)and(tfm[design_size+1]<16) then - bad_design('too small') -else out_fix(design_size); -right; -out('(COMMENT DESIGNSIZE IS IN POINTS)'); out_ln; -out('(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)'); out_ln -@.DESIGNSIZE IS IN POINTS@> - -@ Since we have to check two different {\mc BCPL} strings for validity, -we might as well write a subroutine to make the check. - -@p procedure check_BCPL(@!k,@!l:index); {checks a string of length |<l|} -var j:index; {runs through the string} -@!c:integer; {character being checked} -begin if tfm[k]>=l then - begin bad('String is too long; I''ve shortened it drastically.'); -@.String is too long...@> - tfm[k]:=1; - end; -for j:=k+1 to k+tfm[k] do - begin c:=tfm[j]; - if (c="(")or(c=")") then - begin bad('Parenthesis in string has been changed to slash.'); -@.Parenthesis...changed to slash@> - tfm[j]:="/"; - end - else if (c<" ")or(c>"~") then - begin bad('Nonstandard ASCII code has been blotted out.'); -@.Nonstandard ASCII code...@> - tfm[j]:="?"; - end - else if (c>="a")and(c<="z") then tfm[j]:=c+"A"-"a"; {upper-casify letters} - end; -end; - -@ The |font_type| starts out |vanilla|; possibly we need to reset it. - -@<Set the true |font_type|@>= -begin check_BCPL(scheme,40); -if (tfm[scheme]>=11)and@|(tfm[scheme+1]="T")and@| - (tfm[scheme+2]="E")and@|(tfm[scheme+3]="X")and@| - (tfm[scheme+4]=" ")and@|(tfm[scheme+5]="M")and@| - (tfm[scheme+6]="A")and@|(tfm[scheme+7]="T")and@| - (tfm[scheme+8]="H")and@|(tfm[scheme+9]=" ") then - begin if (tfm[scheme+10]="S")and(tfm[scheme+11]="Y") then font_type:=mathsy - else if (tfm[scheme+10]="E")and(tfm[scheme+11]="X") then font_type:=mathex; - end; -end - -@ @<Output the character coding scheme@>= -left; out('CODINGSCHEME'); -out_BCPL(scheme); -right - -@ @<Output the family name@>= -left; out('FAMILY'); -check_BCPL(family,20); -out_BCPL(family); -right - -@ @<Output the rest of the header@>= -begin left; out('FACE'); out_face(random_word+3); right; -for i:=18 to lh-1 do begin - left; out('HEADER D ',i:1); - out_hex(check_sum+4*i,@,4); right; - end; -end - -@ This program does not check to see if the |seven_bit_safe_flag| has the -correct setting, i.e., if it really reflects the seven-bit-safety of -the \.{TFM} file; the stated value is merely put into the \.{PL} file. -The \.{PLtoTF} program will store a correct value and give a warning -message if a file falsely claims to be safe. - -@<Output the |seven_bit_safe_flag|@>= -begin left; out('SEVENBITSAFEFLAG FALSE'); right; -end - -@ The next thing to take care of is the list of parameters. - -@<Do the parameters@>= -if np>0 then begin - left; out('FONTDIMEN'); out_ln; - for i:=1 to np do @<Check and output the $i$th parameter@>; - right; - end; -@<Check to see if |np| is complete for this font type@>; - -@ @<Check to see if |np|...@>= -if (font_type=mathsy)and(np<>22) then - print_ln('Unusual number of fontdimen parameters for a math symbols font (', -@.Unusual number of fontdimen...@> - np:1,' not 22).') -else if (font_type=mathex)and(np<>13) then - print_ln('Unusual number of fontdimen parameters for an extension font (', - np:1,' not 13).') - -@ All |fix_word| values except the design size and the first parameter -will be checked to make sure that they are less than 16.0 in magnitude, -using the |check_fix| macro: - -@d check_fix_tail(#)==bad(#,' ',i:1,' is too big;'); - print_ln('I have set it to zero.'); - end -@d check_fix(#)==if (tfm[#]>0)and(tfm[#]<255) then - begin tfm[#]:=0; tfm[(#)+1]:=0; tfm[(#)+2]:=0; tfm[(#)+3]:=0; - check_fix_tail - -@<Check and output the $i$th parameter@>= -begin left; -if i=1 then out('SLANT') {this parameter is not checked} -else begin check_fix(param(i))('Parameter');@/ -@.Parameter n is too big@> - @<Output the name of parameter $i$@>; - end; -out_fix(param(i)); right; -end - -@ @<Output the name...@>= -if i<=7 then case i of - 2:out('SPACE');@+3:out('STRETCH');@+4:out('SHRINK'); - 5:out('XHEIGHT');@+6:out('QUAD');@+7:out('EXTRASPACE')@+end -else if (i<=22)and(font_type=mathsy) then case i of - 8:out('NUM1');@+9:out('NUM2');@+10:out('NUM3'); - 11:out('DENOM1');@+12:out('DENOM2'); - 13:out('SUP1');@+14:out('SUP2');@+15:out('SUP3'); - 16:out('SUB1');@+17:out('SUB2'); - 18:out('SUPDROP');@+19:out('SUBDROP'); - 20:out('DELIM1');@+21:out('DELIM2'); - 22:out('AXISHEIGHT')@+end -else if (i<=13)and(font_type=mathex) then - if i=8 then out('DEFAULTRULETHICKNESS') - else out('BIGOPSPACING',i-8:1) -else out('PARAMETER D ',i:1) - -@ @<Glob...@>= -@!start_counter,@!base_counter,@!number_entries:integer; -@!value:integer; - -@ @<Do the ivalue parameters@>= -if nki>0 then begin - start_counter:=ivalues_start*4; - base_counter:=ivalues_base*4; - for i:=0 to nki-1 do @<Check and output the $i$th ivalue table@>; - end; - -@ @<Check and output the $i$th ivalue table@>= -begin -left; out('FONTIVALUE'); out_hex_number(i); out_ln; -number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; -for j:=0 to number_entries-1 do begin - left; out('IVALUE'); out_hex_number(j); out_ln; - value:=256*tfm[base_counter+2]+tfm[base_counter+3]; - left; out('IVALUEVAL'); out_hex_number(value); right; - right; - base_counter:=base_counter+4; - end; -right; -start_counter:=start_counter+4;; -end; - -@ @<Do the fvalue parameters@>= -if nkf>0 then begin - start_counter:=fvalues_start*4; - base_counter:=fvalues_base*4; - for i:=0 to nkf-1 do @<Check and output the $i$th fvalue table@>; - end; - -@ @<Check and output the $i$th fvalue table@>= -begin -left; out('FONTFVALUE'); out_hex_number(i); out_ln; -number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; -for j:=0 to number_entries-1 do begin - left; out('FVALUE'); out_hex_number(j); out_ln; - left; out('FVALUEVAL'); out_fix(base_counter); right; - right; - base_counter:=base_counter+4; - end; -right; -start_counter:=start_counter+4; -end; - -@ @<Do the mvalue parameters@>= -if nkm>0 then begin - start_counter:=mvalues_start*4; - base_counter:=mvalues_base*4; - for i:=0 to nkm-1 do @<Check and output the $i$th mvalue table@>; - end; - -@ @<Check and output the $i$th mvalue table@>= -begin -left; out('FONTMVALUE'); out_hex_number(i); out_ln; -number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; -for j:=0 to number_entries-1 do begin - left; out('MVALUE'); out_hex_number(j); out_ln; - left; out('MVALUEVAL'); out_fix(base_counter); right; - right; - base_counter:=base_counter+4; - end; -right; -start_counter:=start_counter+4; -end; - -@ @<Do the rule parameters@>= -if nkr>0 then - begin - start_counter:=rules_start*4; - base_counter:=rules_base*4; - for i:=0 to nkr-1 do @<Check and output the $i$th rule table@>; - end; - -@ @<Check and output the $i$th rule table@>= -begin -left; out('FONTRULE'); out_hex_number(i); out_ln; -number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; -for j:=0 to number_entries-1 do begin - left; out('RULE'); out_hex_number(j); out_ln; - left; out('RULEWD'); out_fix(base_counter); right; - left; out('RULEHT'); out_fix(base_counter+4); right; - left; out('RULEDP'); out_fix(base_counter+8); right; - right; - base_counter:=base_counter+12; - end; -right; -start_counter:=start_counter+4; -end; - -@ @<Do the glue parameters@>= -if nkg>0 then begin - start_counter:=glues_start*4; - base_counter:=glues_base*4; - for i:=0 to nkg-1 do @<Check and output the $i$th glue table@>; - end; - -@ @<Glob...@>= -@!glue_subtype,@!glue_argument_kind,@!glue_stretch_order, -@!glue_shrink_order,@!glue_argument:integer; - -@ @<Check and output the $i$th glue table@>= -begin -left; out('FONTGLUE'); out_hex_number(i); out_ln; -number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; -for j:=0 to number_entries-1 do begin - left; out('GLUE'); out_hex_number(j); out_ln; - glue_subtype:=tfm[base_counter] div 16; - glue_argument_kind:=tfm[base_counter] mod 16; - glue_stretch_order:=tfm[base_counter+1] div 16; - glue_shrink_order:=tfm[base_counter+1] mod 16; - glue_argument:=tfm[base_counter+2]*256+tfm[base_counter+3]; - left; - out('GLUETYPE'); - case glue_subtype of - 0: out(' H 0'); - 1: out(' H 1'); - 2: out(' H 2'); - 3: out(' H 3'); - end; - right; - case glue_argument_kind of - 1: begin - left; out('GLUERULE'); out_hex_number(glue_argument); right; - end; - 2: begin - left; out('GLUECHAR'); out_hex_number(glue_argument); right; - end; - end; - left; - out('GLUESTRETCHORDER'); - case glue_stretch_order of - 0: out(' H 0'); - 1: out(' H 1'); - 2: out(' H 2'); - 3: out(' H 3'); - 4: out(' H 4'); - end; - right; - left; - out('GLUESHRINKORDER'); - case glue_shrink_order of - 0: out(' H 0'); - 1: out(' H 1'); - 2: out(' H 2'); - 3: out(' H 3'); - 4: out(' H 4'); - end; - right; - left; out('GLUEWD'); out_fix(base_counter+4); right; - left; out('GLUESTRETCH'); out_fix(base_counter+8); right; - left; out('GLUESHRINK'); out_fix(base_counter+12); right; - right; - base_counter:=base_counter+16; - end; -right; -start_counter:=start_counter+4; -end; - -@ @<Do the penalty parameters@>= -if nkp>0 then begin - start_counter:=penalties_start*4; - base_counter:=penalties_base*4; - for i:=0 to nkp-1 do @<Check and output the $i$th penalty table@>; - end; - -@ @<Check and output the $i$th penalty table@>= -begin -left; out('FONTPENALTY'); out_hex_number(i); out_ln; -number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; -for j:=0 to number_entries-1 do begin - left; out('PENALTY'); out_hex_number(j); out_ln; - value:=256*tfm[base_counter+2]+tfm[base_counter+3]; - left; out('PENALTYVAL'); out_hex_number(value); right; - right; - base_counter:=base_counter+4; - end; -right; -start_counter:=start_counter+4; -end; - -@ We need to check the range of all the remaining |fix_word| values, -and to make sure that |width[0]=0|, etc. - -@d nonzero_fix(#)==(tfm[#]>0)or(tfm[#+1]>0)or(tfm[#+2]>0)or(tfm[#+3]>0) - -@<Check the |fix_word| entries@>= -if nonzero_fix(4*width_base) then bad('width[0] should be zero.'); -@.should be zero@> -if nonzero_fix(4*height_base) then bad('height[0] should be zero.'); -if nonzero_fix(4*depth_base) then bad('depth[0] should be zero.'); -if nonzero_fix(4*italic_base) then bad('italic[0] should be zero.'); -for i:=0 to nw-1 do check_fix(4*(width_base+i))('Width'); -@.Width n is too big@> -for i:=0 to nh-1 do check_fix(4*(height_base+i))('Height'); -@.Height n is too big@> -for i:=0 to nd-1 do check_fix(4*(depth_base+i))('Depth'); -@.Depth n is too big@> -for i:=0 to ni-1 do check_fix(4*(italic_base+i))('Italic correction'); -@.Italic correction n is too big@> -if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern'); -@.Kern n is too big@> - -@ The ligature/kerning program comes next. Before we can put it out in -\.{PL} format, we need to make a table of ``labels'' that will be inserted -into the program. For each character |c| whose |tag| is |lig_tag| and -whose starting address is |r|, we will store the pair |(c,r)| in the -|label_table| array. If there's a boundary-char program starting at~|r|, -we also store the pair |(256,r)|. -This array is sorted by its second components, using the -simple method of straight insertion. - -@<Glob...@>= -@!label_table:array[xxxchar_type] of record -@!cc:xchar_type;@!rr:0..lig_size;ischar:boolean;end; -@!label_ptr:xxchar_type; {the largest entry in |label_table|} -@!sort_ptr:xxchar_type; {index into |label_table|} -@!boundary_char:xchar_type; {boundary character, or |xmax_char| if none} -@!bchar_label:0..xmax_label; {beginning of boundary character program} - -@ @<Set init...@>= -boundary_char:=xmax_char; bchar_label:=xmax_label;@/ -label_ptr:=0; label_table[0].rr:=0; {a sentinel appears at the bottom} - -@ We'll also identify and remove inaccessible program steps, using the -|activity| array. - -@d unreachable=0 {a program step not known to be reachable} -@d pass_through=1 {a program step passed through on initialization} -@d accessible=2 {a program step that can be relevant} - -@<Glob...@>= -@!activity:array[0..lig_size] of unreachable..accessible; -@!ai,@!acti:0..lig_size; {indices into |activity|} - -@ @<Do the ligatures and kerns@>= -if nl>0 then - begin for ai:=0 to (nl-1) do activity[ai]:=unreachable; - @<Check for a boundary char@>; - end; -@<Build the label table@>; -if nl>0 then - begin left; out('LIGTABLE'); out_ln;@/ - @<Compute the |activity| array@>; - @<Output and correct the ligature/kern program@>; - right; - @<Check for ligature cycles@>; - end - -@ We build the label table even when |nl=0|, because this catches errors -that would not otherwise be detected. - -@<Build...@>= -for c:=bc to ec do -if (tag(c)=lig_tag) or (ctag(c)) then begin - r:=rremainder(c); - if (l_skip_byte(lig_step(r)) div 256)=0 then begin - if r<nl then begin - if l_skip_byte(lig_step(r))>stop_flag then begin - r:=256*l_op_byte(lig_step(r))+l_remainder(lig_step(r)); - if r<nl then - if activity[rremainder(c)]=unreachable then - activity[rremainder(c)]:=pass_through; - end; - end; - end; - if r>=nl then begin - perfect:=false; print_ln(' '); - print('Ligature/kern starting index for character '); print_hex(c); - print_ln(' is too large;'); print_ln('so I removed it.'); set_no_tag(c); - set_no_ctag(c); -@.Ligature/kern starting index...@> - end - else @<Insert |(c,r)| into |label_table|@>; - end; -label_table[label_ptr+1].rr:=lig_size; {put ``infinite'' sentinel at the end} - -@ @<Insert |(c,r)|...@>= -begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|} -while label_table[sort_ptr].rr>r do begin - label_table[sort_ptr+1]:=label_table[sort_ptr]; - decr(sort_ptr); {move the hole} - end; -label_table[sort_ptr+1].ischar:=not ctag(c); -if ctag(c) then - label_table[sort_ptr+1].cc:=char_param(c,0) -else - label_table[sort_ptr+1].cc:=c; -label_table[sort_ptr+1].rr:=r; {fill the hole} -incr(label_ptr); activity[r]:=accessible; -end - -@ @<Check for a bound...@>= -if l_skip_byte(lig_step(0))=255 then begin - left; out('BOUNDARYCHAR'); - boundary_char:=l_next_char(lig_step(0)); out_char(boundary_char); right; - activity[0]:=pass_through; - end; -if l_skip_byte(lig_step(nl-1))=255 then begin - r:=256*l_op_byte(lig_step(nl-1))+l_remainder(lig_step(nl-1)); - if r>=nl then begin - perfect:=false; print_ln(' '); - print('Ligature/kern starting index for boundarychar is too large;'); - print_ln('so I removed it.'); -@.Ligature/kern starting index...@> - end - else begin label_ptr:=1; label_table[1].cc:=xmax_char; - label_table[1].rr:=r; - bchar_label:=r; activity[r]:=accessible; - end; - activity[nl-1]:=pass_through; - end - -@ @<Compute the |activity| array@>= -for ai:=0 to (nl-1) do -if (l_skip_byte(lig_step(ai)) div 256)=1 then - activity[ai]:=accessible -else if activity[ai]=accessible then begin - r:=l_skip_byte(lig_step(ai)); - if r<stop_flag then begin - r:=r+ai+1; - if r>=nl then begin - bad('Ligature/kern step ',ai:1,' skips too far;'); -@.Lig...skips too far@> - print_ln('I made it stop.'); set_l_skip_byte(lig_step(ai),stop_flag); - end - else activity[r]:=accessible; - end; - end - -@ We ignore |pass_through| items, which don't need to be mentioned in -the \.{PL} file. - -@<Output and correct the ligature...@>= -sort_ptr:=1; {point to the next label that will be needed} -for acti:=0 to nl-1 do if activity[acti]<>pass_through then - begin i:=acti; @<Take care of commenting out unreachable steps@>; - @<Output any labels for step $i$@>; - @<Output step $i$ of the ligature/kern program@>; - end; -if level=2 then right {the final step was unreachable} - -@ @<Globals...@>= -@!output_clabels:array[0..256] of boolean; -@!clabel_runner:integer; - -@ @<Set init...@>= -for clabel_runner:=0 to 256 do - output_clabels[clabel_runner]:=false; - -@ @<Output any labels...@>= -while i=label_table[sort_ptr].rr do begin - if not label_table[sort_ptr].ischar then begin - if not output_clabels[label_table[sort_ptr].cc] then begin - output_clabels[label_table[sort_ptr].cc]:=true; - left; - out('CLABEL'); - out_char(label_table[sort_ptr].cc); - right; - end - end - else begin - left; - out('LABEL'); - if label_table[sort_ptr].cc=xmax_char then out(' BOUNDARYCHAR') - else out_char(label_table[sort_ptr].cc); - right; - end; - incr(sort_ptr); - end - -@ @<Take care of commenting out...@>= -if activity[i]=unreachable then begin - if level=1 then begin - left; out('COMMENT THIS PART OF THE PROGRAM IS NEVER USED!'); out_ln; - end - end -else if level=2 then right - -@ @<Output step $i$...@>= -begin k:=lig_step(i); -if (l_skip_byte(k) div 256)=1 then begin - case l_op_byte(k) of - 17: begin - left; out('CPEN'); - out_hex_number(l_next_char(k)); - out_hex_number(l_remainder(k)); - right; - end; - 18: begin - left; out('CGLUE'); - out_hex_number(l_next_char(k)); - out_hex_number(l_remainder(k)); - right; - end; - 19: begin - left; out('CPENGLUE'); - out_hex_number(l_next_char(k)); - out_hex_number(l_remainder(k) div 256); - out_hex_number(l_remainder(k) mod 256); - right; - end; - 20: begin - left; out('CKRN'); - out_hex_number(l_next_char(k)); - r:=l_remainder(k); - if r>=nk then begin - bad('Kern index too large.'); -@.Kern index too large@> - out(' R 0.0'); - end - else out_fix(kern(r)); - right; - end; - end; - end -else if l_skip_byte(k)>stop_flag then begin - if (256*l_op_byte(k)+l_remainder(k))>=nl then - bad('Ligature unconditional stop command address is too big.'); -@.Ligature unconditional stop...@> - end -else if l_op_byte(k)>=kern_flag then @<Output a kern step@> -else @<Output a ligature step@>; -if (l_skip_byte(k) mod 256)>0 then - if level=1 then @<Output either \.{SKIP} or \.{STOP}@>; -end - -@ The \.{SKIP} command is a bit tricky, because we will be omitting all -inaccessible commands. - -@<Output either...@>= -begin -if (l_skip_byte(k) mod 256)>=stop_flag then out('(STOP)') -else begin - count:=0; - for ai:=(i+1) to (i+(l_skip_byte(k) mod 256)) do - if activity[ai]=accessible then incr(count); - out('(SKIP D ',count:1,')'); {possibly $count=0$, so who cares} - end; -out_ln; -end - -@ @<Output a kern step@>= -begin if nonexistent(l_next_char(k)) then - if l_next_char(k)<>boundary_char then - correct_bad_char('Kern step for')(l_next_char)(set_l_next_char); -@.Kern step for nonexistent...@> -left; out('KRN'); out_char(l_next_char(k)); -r:=256*(l_op_byte(k)-kern_flag)+l_remainder(k); -if r>=nk then - begin bad('Kern index too large.'); -@.Kern index too large@> - out(' R 0.0'); - end -else out_fix(kern(r)); -right; -end - -@ @<Output a ligature step@>= -begin -if nonexistent(l_next_char(k)) then - if l_next_char(k)<>boundary_char then - correct_bad_char('Ligature step for')(l_next_char)(set_l_next_char); -@.Ligature step for nonexistent...@> -if nonexistent(l_remainder(k)) then - correct_bad_char('Ligature step produces the')(l_remainder)(set_l_remainder); -@.Ligature step produces...@> -left; r:=l_op_byte(k); -if (r=4)or((r>7)and(r<>11)) then begin - print_ln('Ligature step with nonstandard code changed to LIG'); - r:=0; set_l_op_byte(k,0); - end; -if r mod 4>1 then out('/'); -out('LIG'); -if odd(r) then out('/'); -while r>3 do begin - out('>'); r:=r-4; - end; -out_char(l_next_char(k)); out_char(l_remainder(k)); right; -end - -@ The last thing on \.{TFtoPL}'s agenda is to go through the -list of |char_info| and spew out the information about each individual -character. - -@<Do the characters@>= -sort_ptr:=0; {this will suppress `\.{STOP}' lines in ligature comments} -c:=bc; -while (c<=ec) do -begin -if width_index(c)>0 then begin - if chars_on_line=8 then begin - print_ln(' '); chars_on_line:=1; - end - else begin - if chars_on_line>0 then print(' '); - incr(chars_on_line); - end; - if no_repeats(c)>0 then begin - print_hex(c); print('-'); print_hex(c+no_repeats(c)); - left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln; - end - else begin - print_hex(c); {progress report} - left; out('CHARACTER'); out_char(c); out_ln; - end; - @<Output the character's width@>; - if height_index(c)>0 then @<Output the character's height@>; - if depth_index(c)>0 then @<Output the character's depth@>; - if italic_index(c)>0 then @<Output the italic correction@>; - case tag(c) of - no_tag: do_nothing; - lig_tag: @<Output the applicable part of the ligature/kern - program as a comment@>; - list_tag: @<Output the character link unless there is a problem@>; - ext_tag: @<Output an extensible character recipe@>; - end; {there are no other cases} - for i:=0 to npc-1 do begin - if char_param(c,i)<>0 then begin - left; - if i<nki then begin - out('CHARIVALUE'); out_hex_number(i); - end - else if i<(nki+nkf) then begin - out('CHARFVALUE'); out_hex_number(i-nki); - end - else if i<(nki+nkf+nkr) then begin - out('CHARRULE'); out_hex_number(i-nki-nkf); - end - else if i<(nki+nkf+nkr+nkg) then begin - out('CHARGLUE'); out_hex_number(i-nki-nkf-nkr); - end - else if i<(nki+nkf+nkr+nkg+nkp) then begin - out('CHARPENALTY'); out_hex_number(i-nki-nkf-nkr-nkg); - end; - out_hex_number(char_param(c,i)); - right; - end; - end; - right; - end; -c:=c+1+no_repeats(c); -end - -@ @<Output the character's width@>= -if width_index(c)>=nw then range_error('Width') -@.Width index for char...@> -else begin left; out('CHARWD'); out_fix(width(c)); right; - end - -@ @<Output the character's height@>= -if height_index(c)>=nh then range_error('Height') -@.Height index for char...@> -else begin left; out('CHARHT'); out_fix(height(c)); right; - end - -@ @<Output the character's depth@>= -if depth_index(c)>=nd then range_error('Depth') -@.Depth index for char@> -else begin left; out('CHARDP'); out_fix(depth(c)); right; - end - -@ @<Output the italic correction@>= -if italic_index(c)>=ni then range_error('Italic correction') -@.Italic correction index for char...@> -else begin left; out('CHARIC'); out_fix(italic(c)); right; - end - -@ @<Output the applicable part of the ligature...@>= -begin left; out('COMMENT'); out_ln;@/ -i:=rremainder(c); r:=lig_step(i); -if (l_skip_byte(r) mod 256)>stop_flag -then i:=256*l_op_byte(r)+l_remainder(r); -repeat @<Output step...@>; -if (l_skip_byte(k) mod 256)>=stop_flag then i:=nl -else i:=i+1+(l_skip_byte(k) mod 256); -until i>=nl; -right; -end - -@ We want to make sure that there is no cycle of characters linked together -by |list_tag| entries, since such a cycle would get \TeX\ into an endless -loop. If such a cycle exists, the routine here detects it when processing -the largest character code in the cycle. - -@<Output the character link unless there is a problem@>= -begin r:=rremainder(c); -if nonexistent(r) then - begin bad_char('Character list link to')(r); set_no_tag(c); -@.Character list link...@> - end -else begin while (r<c)and(tag(r)=list_tag) do r:=rremainder(r); - if r=c then - begin bad('Cycle in a character list!'); -@.Cycle in a character list@> - print('Character '); print_hex(c); - print_ln(' now ends the list.'); - set_no_tag(c); - end - else begin left; out('NEXTLARGER'); out_char(rremainder(c)); - right; - end; - end; -end - -@ @<Output an extensible character recipe@>= -if rremainder(c)>=ne then - begin range_error('Extensible'); set_no_tag(c); -@.Extensible index for char@> - end -else begin left; out('VARCHAR'); out_ln; - @<Output the extensible pieces that exist@>; - right; - end - -@ @<Glob...@>= -@!exten_char:integer; - -@ @<Output the extensible pieces that...@>= -for d:=0 to 3 do begin - if not ofm_on then begin - k:=exten(c)+d; - exten_char:=tfm[k]; - end - else begin - k:=exten(c)+2*d; - exten_char:=256*tfm[k]+tfm[k+1]; - end; - if (d=3)or(exten_char>0) then begin - left; - case d of - 0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end; - if nonexistent(exten_char) then out_char(c) - else out_char(exten_char); - right; - end - end - -@ Some of the extensible recipes may not actually be used, but \TeX\ will -complain about them anyway if they refer to nonexistent characters. -Therefore \.{TFtoPL} must check them too. - -@<Check the extensible recipes@>= -if ne>0 then - for c:=0 to ne-1 do - for d:=0 to 3 do begin - if not ofm_on then begin - k:=4*(exten_base+c)+d; - exten_char:=tfm[k]; - end - else begin - k:=4*(exten_base+c)+2*d; - exten_char:=256*tfm[k]+tfm[k+1]; - end; - if (exten_char>0)or(d=3) then begin - if nonexistent(exten_char) then begin - bad_char('Extensible recipe involves the')(exten_char); -@.Extensible recipe involves...@> - if d<3 then begin - if not ofm_on then begin - tfm[k]:=0; - end - else begin - tfm[k]:=0; - tfm[k+1]:=0; - end; - end; - end; - end; - end - -@* Checking for ligature loops. -We have programmed almost everything but the most interesting calculation of -all, which has been saved for last as a special treat. \TeX's extended -ligature mechanism allows unwary users to specify sequences of ligature -replacements that never terminate. For example, the pair of commands -$$\.{(/LIG $x$ $y$) (/LIG $y$ $x$)}$$ -alternately replaces character $x$ by character $y$ and vice versa. A similar -loop occurs if \.{(LIG/ $z$ $y$)} occurs in the program for $x$ and - \.{(LIG/ $z$ $x$)} occurs in the program for $y$. - -More complicated loops are also possible. For example, suppose the ligature -programs for $x$ and $y$ are -$$\vcenter{\halign{#\hfil\cr -\.{(LABEL $x$)(/LIG/ $z$ $w$)(/LIG/> $w$ $y$)} \dots,\cr -\.{(LABEL $y$)(LIG $w$ $x$)} \dots;\cr}}$$ -then the adjacent characters $xz$ change to $xwz$, $xywz$, $xxz$, $xxwz$, -\dots, ad infinitum. - -@ To detect such loops, \.{TFtoPL} attempts to evaluate the function -$f(x,y)$ for all character pairs $x$ and~$y$, where $f$ is defined as -follows: If the current character is $x$ and the next character is -$y$, we say the ``cursor'' is between $x$ and $y$; when the cursor -first moves past $y$, the character immediately to its left is -$f(x,y)$. This function is defined if and only if no infinite loop is -generated when the cursor is between $x$ and~$y$. - -The function $f(x,y)$ can be defined recursively. It turns out that all pairs -$(x,y)$ belong to one of five classes. The simplest class has $f(x,y)=y$; -this happens if there's no ligature between $x$ and $y$, or in the cases -\.{LIG/>} and \.{/LIG/>>}. Another simple class arises when there's a -\.{LIG} or \.{/LIG>} between $x$ and~$y$, generating the character~$z$; -then $f(x,y)=z$. Otherwise we always have $f(x,y)$ equal to -either $f(x,z)$ or $f(z,y)$ or $f(f(x,z),y)$, where $z$ is the inserted -ligature character. - -The first two of these classes can be merged; we can also consider -$(x,y)$ to belong to the simple class when $f(x,y)$ has been evaluated. -For technical reasons we allow $x$ to be 256 (for the boundary character -at the left) or 257 (in cases when an error has been detected). - -For each pair $(x,y)$ having a ligature program step, we store -$(x,y)$ in a hash table from which the values $z$ and $class$ can be read. - -@d simple=0 {$f(x,y)=z$} -@d left_z=1 {$f(x,y)=f(z,y)$} -@d right_z=2 {$f(x,y)=f(x,z)$} -@d both_z=3 {$f(x,y)=f(f(x,z),y)$} -@d pending=4 {$f(x,y)$ is being evaluated} - -@<Glob...@>= -@!hash:array[0..hash_size] of integer; -@!class:array[0..hash_size] of simple..pending; -@!lig_z:array[0..hash_size] of xxchar_type; -@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|} -@!hash_list:array[0..hash_size] of 0..hash_size; - {list of those nonzero entries} -@!h,@!hh:0..hash_size; {indices into the hash table} -@!x_lig_cycle,@!y_lig_cycle:integer; {problematic ligature pair} - -@ @<Check for ligature cycles@>= -hash_ptr:=0; y_lig_cycle:=xmax_char; -for hh:=0 to hash_size do hash[hh]:=0; {clear the hash table} -for c:=bc to ec do if tag(c)=lig_tag then - begin i:=rremainder(c); - if (l_skip_byte(lig_step(i)) mod 256)>stop_flag then - i:=256*l_op_byte(lig_step(i))+l_remainder(lig_step(i)); - @<Enter data for character $c$ starting at location |i| in the hash table@>; - end; -if bchar_label<nl then - begin c:=xmax_char; i:=bchar_label; - @<Enter data for character $c$ starting at location |i| in the hash table@>; - end; -if hash_ptr=hash_size then - begin print_ln('Sorry, I haven''t room for so many ligature/kern pairs!'); -@.Sorry, I haven't room...@> - goto final_end; - end; -for hh:=1 to hash_ptr do - begin r:=hash_list[hh]; - if class[r]>simple then {make sure $f$ is defined} - r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char); - end; -if y_lig_cycle<xmax_char then - begin print('Infinite ligature loop starting with '); -@.Infinite ligature loop...@> - if x_lig_cycle=xmax_char - then print('boundary')@+else print_hex(x_lig_cycle); - print(' and '); print_hex(y_lig_cycle); print_ln('!'); - out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end; - end - -@ @<Enter data for character $c$...@>= -repeat hash_input; k:=l_skip_byte(lig_step(i)); -if k>=stop_flag then i:=nl -else i:=i+1+k; -until i>=nl - -@ We use an ``ordered hash table'' with linear probing, because such a table -is efficient when the lookup of a random key tends to be unsuccessful. - -@p procedure hash_input; {enter data for character |c| and command |i|} -label 30; {go here for a quick exit} -var @!cc:simple..both_z; {class of data being entered} -@!zz:char_type; {function value or ligature character being entered} -@!y:char_type; {the character after the cursor} -@!key:integer; {value to be stored in |hash|} -@!t:integer; {temporary register for swapping} -begin if hash_ptr=hash_size then goto 30; -@<Compute the command parameters |y|, |cc|, and |zz|@>; -key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size; -while hash[h]>0 do - begin if hash[h]<=key then - begin if hash[h]=key then goto 30; {unused ligature command} - t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion} - t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap} - t:=lig_z[h]; lig_z[h]:=zz; zz:=t; - end; - if h>0 then decr(h)@+else h:=hash_size; - end; -hash[h]:=key; class[h]:=cc; lig_z[h]:=zz; -incr(hash_ptr); hash_list[hash_ptr]:=h; -30:end; - -@ We must store kern commands as well as ligature commands, because -the former might make the latter inapplicable. - -@<Compute the command param...@>= -k:=lig_step(i); y:=l_next_char(k); t:=l_op_byte(k); -cc:=simple; zz:=l_remainder(k); -if t>=kern_flag then zz:=y -else begin case t of - 0,6:do_nothing; {\.{LIG},\.{/LIG>}} - 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}} - 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}} - 2:cc:=right_z; {\.{/LIG}} - 3:cc:=both_z; {\.{/LIG/}} - end; {there are no other cases} - end - -@ Evaluation of $f(x,y)$ is handled by two mutually recursive procedures. -Kind of a neat algorithm, generalizing a depth-first search. - -@p function f(@!h,@!x,@!y:index):index; forward;@t\2@> - {compute $f$ for arguments known to be in |hash[h]|} -function eval(@!x,@!y:index):index; {compute $f(x,y)$ with hashtable lookup} -var @!key:integer; {value sought in hash table} -begin key:=xmax_char*x+y+1; h:=(hash_mult*key) mod hash_size; -while hash[h]>key do - if h>0 then decr(h)@+else h:=hash_size; -if hash[h]<key then eval:=y {not in ordered hash table} -else eval:=f(h,x,y); -end; - -@ Pascal's beastly convention for |forward| declarations prevents us from -saying |function f(h,x,y:index):index| here. - -@p function f; -begin case class[h] of -simple: do_nothing; -left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple; - end; -right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple; - end; -both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y); - class[h]:=simple; - end; -pending: begin x_lig_cycle:=x; y_lig_cycle:=y; - lig_z[h]:=xxmax_char; class[h]:=simple; - end; {the value |xxmax_char| will break all cycles, - since it's not in |hash|} -end; {there are no other cases} -f:=lig_z[h]; -end; - -@* The main program. -The routines sketched out so far need to be packaged into separate procedures, -on some systems, since some \PASCAL\ compilers place a strict limit on the -size of a routine. The packaging is done here in an attempt to avoid some -system-dependent changes. - -First comes the |organize| procedure, which reads the input data and -gets ready for subsequent events. If something goes wrong, the routine -returns |false|. - -@p function organize:boolean; -label final_end, 30; -var tfm_ptr:index; {an index into |tfm|} -begin @<Read the whole input file@>;@/ -@<Set subfile sizes |lh|, |bc|, \dots, |np|@>;@/ -@<Compute the base addresses@>;@/ -organize:=true; goto 30; -final_end: organize:=false; -30: end; - -@ Next we do the simple things. - -@p procedure do_simple_things; -var i:integer; {an index to words of a subfile} -begin @<Do the header@>;@/ -@<Do the parameters@>;@/ -@<Do the ivalue parameters@>;@/ -@<Do the fvalue parameters@>;@/ -@<Do the mvalue parameters@>;@/ -@<Do the rule parameters@>;@/ -@<Do the glue parameters@>;@/ -@<Do the penalty parameters@>;@/ -@<Check the |fix_word| entries@>@/ -end; - -@ And then there's a routine for individual characters. - -@p procedure do_characters; -var @!c:integer; {character being done} -@!k:index; {a random index} -@!ai:0..lig_size; {index into |activity|} -begin @<Do the characters@>;@/ -end; - -@ Here is where \.{TFtoPL} begins and ends. -@p begin initialize;@/ -if not organize then goto final_end; -do_simple_things;@/ -@<Do the ligatures and kerns@>; -@<Check the extensible recipes@>; -do_characters; print_ln('.');@/ -if level<>0 then print_ln('This program isn''t working!'); -@.This program isn't working@> -if not perfect then - out('(COMMENT THE OFM FILE WAS BAD, SO THE DATA HAS BEEN CHANGED!)'); -@.THE OFM FILE WAS BAD...@> -final_end:end. - -@* System-dependent changes. -This section should be replaced, if necessary, by changes to the program -that are necessary to make \.{TFtoPL} 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 printed 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@> - -@* Index. -Pointers to error messages appear here together with the section numbers -where each ident\-i\-fier is used. diff --git a/Build/source/texk/web2c/omegaware/opl2ofm.ch b/Build/source/texk/web2c/omegaware/opl2ofm.ch deleted file mode 100644 index d4b4b372b14..00000000000 --- a/Build/source/texk/web2c/omegaware/opl2ofm.ch +++ /dev/null @@ -1,337 +0,0 @@ -% -% This file is part of the Omega project, which -% is based in the web2c distribution of TeX. -% -% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous -% applies only to the changes to the original pltotf.ch. -% -% pltotf.ch for C compilation with web2c. -% -% 04/04/83 (PC) Original version, made to work with version 1.2 of PLtoTF. -% 04/16/83 (PC) Brought up to version 1.3 of PLtoTF. -% 06/30/83 (HWT) Revised changefile format for version 1.7 Tangle -% 07/28/83 (HWT) Brought up to version 2 -% 12/19/86 (ETM) Brought up to version 2.1 -% 07/05/87 (ETM) Brought up to version 2.3 -% 03/22/88 (ETM) Converted for use with WEB to C -% 11/29/89 (KB) Version 3. -% 01/16/90 (SR) Version 3.2. -% (more recent changes in the ChangeLog) - -@x [0] WEAVE: print changes only. -\pageno=\contentspagenumber \advance\pageno by 1 -@y -\pageno=\contentspagenumber \advance\pageno by 1 -%\let\maybe=\iffalse -%\def\title{OPL2OFM changes for C} -@z - -@x [still 2] No banner unless verbose. -procedure initialize; {this procedure gets things started properly} - var @<Local variables for initialization@>@/ - begin print_ln(banner);@/ -@y -@<Define |parse_arguments|@> -procedure initialize; {this procedure gets things started properly} - var @<Local variables for initialization@>@/ -begin - kpse_set_progname (argv[0]); - parse_arguments; -@z - -@x [3] Larger constants. -@!buf_size=60; {length of lines displayed in error messages} -@y -@!buf_size=3000; {max input line length, output error line length} -@z -%@x -%@!max_lig_steps=5000; -% {maximum length of ligature program, must be at most $32767-257=32510$} -%@!max_kerns=500; {the maximum number of distinct kern values} -%@!hash_size=5003; {preferably a prime number, a bit larger than the number -% of character pairs in lig/kern steps} -%@y -%@!max_lig_steps=32500; -% {maximum length of ligature program, must be at most $32767-257=32510$} -%@!max_kerns=15000; {the maximum number of distinct kern values} -%@!hash_size=15077; {preferably a prime number, a bit larger than the number -% of character pairs in lig/kern steps} -%@z - -@x [6] Open PL file. -reset(pl_file); -@y -reset (pl_file, pl_name); -if verbose then begin - print (banner); - print_ln (version_string); -end; -@z - -@x [16] Open TFM file. -@ On some systems you may have to do something special to write a -packed file of bytes. For example, the following code didn't work -when it was first tried at Stanford, because packed files have to be -opened with a special switch setting on the \PASCAL\ that was used. -@^system dependencies@> - -@<Set init...@>= -rewrite(tfm_file); -@y -@ On some systems you may have to do something special to write a -packed file of bytes. It's no problem in C. -@^system dependencies@> - -@<Set init...@>= -rewritebin (tfm_file, tfm_name); -@z - -@x [79] `index' might be a library routine. -|k|th element of its list. -@y -|k|th element of its list. -@d index == index_var -@z - -@x [103] No output (except errors) unless verbose. -@<Print |c| in hex notation@>; -@y -if verbose then @<Print |c| in hex notation@>; -@z - -% [27, 28] Change strings to C char pointers. The Pascal strings are -% indexed starting at 1, so we pad with a blank. -@x -@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char; - {strings for output in the user's external character set} -@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char; - {handy string constants for |face| codes} -@y -@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: c_string; - {strings for output in the user's external character set} -@!ASCII_all: packed array[0..256] of char; -@!MBL_string,@!RI_string,@!RCE_string: c_string; - {handy string constants for |face| codes} -@z - -@x -ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ -ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ -ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/ -HEX:='0123456789ABCDEF';@/ -MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE'; -@y -ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ -ASCII_10:=' @@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ -ASCII_14:=' `abcdefghijklmnopqrstuvwxyz{|}~ ';@/ -HEX:=' 0123456789ABCDEF';@/ -strcpy (ASCII_all, ASCII_04); -strcat (ASCII_all, '@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'); -strcat (ASCII_all, '`abcdefghijklmnopqrstuvwxyz{|}~');@/ -MBL_string:=' MBL'; RI_string:=' RI '; RCE_string:=' RCE'; -@z - -@x [115] Output of reals. -@ @d round_message(#)==if delta>0 then print_ln('I had to round some ', -@.I had to round...@> - #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.') -@y -@ @d round_message(#)==if delta>0 then begin print('I had to round some ', -@.I had to round...@> - #,'s by '); print_real((((delta+1) div 2)/@'4000000),1,7); - print_ln(' units.'); end -@z - -% [118] Change the name of the variable `class', since AIX 3.1's <math.h> -% defines a function by that name. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x -@d pending=4 {$f(x,y)$ is being evaluated} -@y -@d pending=4 {$f(x,y)$ is being evaluated} -@d class == class_var {Avoid problems with AIX \.{<math.h>}} -@z - -% [123] web2c can't handle these mutually recursive procedures. -% But let's do a fake definition of f here, so that it gets into web2c's -% symbol table... -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x -@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@> - {compute $f$ for arguments known to be in |hash[h]|} -@y -@p -ifdef('notdef') -function f(@!h,@!x,@!y:indx):indx; begin end;@t\2@> - {compute $f$ for arguments known to be in |hash[h]|} -endif('notdef') -@z - -% [124] ... and then really define it now. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x -@p function f; -@y -@p function f(@!h,@!x,@!y:indx):indx; -@z - -@x [127] Fix up output of bytes. -@d out(#)==write(tfm_file,#) -@y -@d out(#)==putbyte(#,tfm_file) -@z - -@x [136] Fix output of reals. -@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|} -var @!n:byte; {the first byte after the sign} -@!m:0..65535; {the two least significant bytes} -begin if abs(x/design_units)>=16.0 then begin - print_ln('The relative dimension ',x/@'4000000:1:3, - ' is too large.'); -@.The relative dimension...@> - print(' (Must be less than 16*designsize'); - if design_units<>unity then print(' =',design_units/@'200000:1:3, - ' designunits'); -@y -@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|} -var @!n:byte; {the first byte after the sign} -@!m:0..65535; {the two least significant bytes} -begin if fabs(x/design_units)>=16.0 then begin - print('The relative dimension '); - print_real(x/@'4000000,1,3); - print_ln(' is too large.'); -@.The relative dimension...@> - print(' (Must be less than 16*designsize'); - if design_units<>unity then begin print(' ='); - print_real(design_units/@'200000,1,3); - print(' designunits'); - end; -@z - -% [141] char_remainder[c] is unsigned, and label_table[sort_ptr].rr -% might be -1, and if -1 is coerced to being unsigned, it will be bigger -% than anything else. -@x - while label_table[sort_ptr].rr>char_remainder[c] do begin -@y - while label_table[sort_ptr].rr>intcast(char_remainder[c]) do begin -@z - -@x [147] Be quiet unless verbose. -read_input; print('.');@/ -@y -read_input; -if verbose then print_ln('.'); -@z - -@x [148] System-dependent changes. -This section should be replaced, if necessary, by changes to the program -that are necessary to make \.{PLtoTF} 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 printed 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@> -@y -Parse a Unix-style command line. - -@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0) - -@<Define |parse_arguments|@> = -procedure parse_arguments; -const n_options = 3; {Pascal won't count array lengths for us.} -var @!long_options: array[0..n_options] of getopt_struct; - @!getopt_return_val: integer; - @!option_index: c_int_type; - @!current_option: 0..n_options; -begin - @<Initialize the option variables@>; - @<Define the option table@>; - repeat - getopt_return_val := getopt_long_only (argc, argv, '', long_options, - address_of (option_index)); - if getopt_return_val = -1 then begin - {End of arguments; we exit the loop below.} ; - - end else if getopt_return_val = "?" then begin - usage ('opl2ofm'); - - end else if argument_is ('help') then begin - usage_help (OPL2OFM_HELP, nil); - - end else if argument_is ('version') then begin - print_version_and_exit - (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth', nil); - - end; {Else it was a flag; |getopt| has already done the assignment.} - until getopt_return_val = -1; - - {Now |optind| is the index of first non-option on the command line. - We must have one or two remaining arguments.} - if (optind + 1 <> argc) and (optind + 2 <> argc) then begin - write_ln (stderr, 'opl2ofm: Need one or two file arguments.'); - usage ('opl2ofm'); - end; - - pl_name := extend_filename (cmdline (optind), 'opl'); - - {If an explicit output filename isn't given, construct it from |pl_name|.} - if optind + 2 = argc then begin - tfm_name := extend_filename (cmdline (optind + 1), 'ofm'); - end else begin - tfm_name := basename_change_suffix (pl_name, '.opl', '.ofm'); - end; -end; - -@ Here are the options we allow. The first is one of the standard GNU options. -@.-help@> - -@<Define the option...@> = -current_option := 0; -long_options[current_option].name := 'help'; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; -incr (current_option); - -@ Another of the standard options. -@.-version@> - -@<Define the option...@> = -long_options[current_option].name := 'version'; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; -incr (current_option); - -@ Print progress information? - -@<Define the option...@> = -long_options[current_option].name := 'verbose'; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := address_of (verbose); -long_options[current_option].val := 1; -incr (current_option); - -@ -@<Glob...@> = -@!verbose: c_int_type; - -@ -@<Initialize the option...@> = -verbose := false; - -@ An element with all zeros always ends the list. - -@<Define the option...@> = -long_options[current_option].name := 0; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; - -@ Global filenames. - -@<Global...@> = -@!tfm_name,@!pl_name:c_string; -@z diff --git a/Build/source/texk/web2c/omegaware/opl2ofm.web b/Build/source/texk/web2c/omegaware/opl2ofm.web deleted file mode 100644 index df91a25dfee..00000000000 --- a/Build/source/texk/web2c/omegaware/opl2ofm.web +++ /dev/null @@ -1,4363 +0,0 @@ -% -% This file is part of the Omega project, which -% is based in the web2c distribution of TeX. -% -% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous -% applies only to the changes to the original pltotf.web -% -% This program by D. E. Knuth is not copyrighted and can be used freely. -% Version 0 was implemented in January 1982. -% In February 1982 a new restriction on ligature steps was added. -% In June 1982 the routines were divided into smaller pieces for IBM people. -% Hex was added in September 1982, and the result became "Version 1". -% Version 1.1 fixed a bug in section 28 (since eoln is undefined after eof). -% Slight changes were made in October, 1982, for version 0.6 of TeX. -% Version 1.2 fixed a bug in section 115 (TOP, MID, and BOT can be zero) -% Version 1.3 (April 1983) blanked out unused BCPL header bytes -% Version 2 (July 1983) was released with TeX version 0.999. -% Version 2.1 (September 1983) changed TEXINFO to FONTDIMEN. -% Version 2.2 (May 1985) added checksum computation to match METAFONT. -% Version 2.3 (August 1985) introduced `backup' to fix a minor bug. -% Version 3 (October 1989) introduced extended ligature features. -% Version 3.1 (November 1989) fixed two bugs (notably min_nl:=0). -% Version 3.2 (December 1989) improved `shorten', increased max_letters. -% Version 3.3 (September 1990) fixed `nonexistent char 0' (John Gourlay). -% Version 3.4 (March 1991) has more robust `out_scaled' (Wayne Sullivan). -% Version 3.5 (March 1995) initialized lk_step_ended (Armin K\"ollner). - -% Version 1.0 of OPL2OFM (March 1997) allows one to read OPL files -% and generate OFM files. - -% Here is TeX material that gets inserted after \input webmac -\def\hang{\hangindent 3em\indent\ignorespaces} -\font\ninerm=cmr9 -\let\mc=\ninerm % medium caps for names like SAIL -\def\PASCAL{Pascal} -\font\logo=logo10 % for the METAFONT logo -\def\MF{{\logo METAFONT}} - -\def\(#1){} % this is used to make section names sort themselves better -\def\9#1{} % this is used for sort keys in the index - -\def\title{OPL2OFM} -\def\contentspagenumber{301} -\def\topofcontents{\null - \def\titlepage{F} % include headline on the contents page - \def\rheader{\mainfont\hfil \contentspagenumber} - \vfill - \centerline{\titlefont The {\ttitlefont OPL2OFM} processor} - \vskip 15pt - \centerline{(Version 1.11, February 2000)} - \vfill} -\def\botofcontents{\vfill - \centerline{\hsize 5in\baselineskip9pt - \vbox{\ninerm\noindent - The preparation of the original report - was supported in part by the National Science - Foundation under grants IST-8201926 and MCS-8300984, - and by the System Development Foundation. `\TeX' is a - trademark of the American Mathematical Society.}}} -\pageno=\contentspagenumber \advance\pageno by 1 - -@* Introduction. -The \.{OPL2OFM} utility program converts property-list (``\.{PL}'' -and (``\.{OPL}'') files into equivalent \TeX\ and $\Omega$ font metric -(``\.{TFM}'' and ``\.{OFM}) files. It also makes a thorough check of -the given \.{PL} or \.{OPL} file, so that the \.{TFM} or \.{OFM} file -should be acceptable to \TeX\ or $\Omega$. - -The first \.{PLtoTF} program was designed by Leo Guibas in the summer of -1978. Contributions by Frank Liang, Doug Wyatt, and Lyle Ramshaw -also had a significant effect on the evolution of the present code. - -Extensions for an enhanced ligature mechanism were added by D. E. Knuth -in 1989. - -Extensions to handle extended font metric files (``\.{OFM}'') were -added by John Plaice in December 1995 and January 1996, resulting in the -new program \.{OPLtoOFM}. In the following documentation, all unchanged -references to the \.{PLtoTF} program and to \.{TFM} and \.{PL} files also -apply to the \.{OPLtoOFM} program and to \.{OFM} and \.{OPL} files. - -The |banner| string defined here should be changed whenever \.{OPLtoOFM} -gets modified. - -@d banner=='This is OPL2OFM, Version 1.11' - -@ This program is written entirely in standard \PASCAL, except that -it has to do some slightly system-dependent character code conversion -on input. Furthermore, lower case letters are used in error messages; -they could be converted to upper case if necessary. The input is read -from |pl_file|, and the output is written on |tfm_file|; error messages and -other remarks are written on the |output| file, which the user may -choose to assign to the terminal if the system permits it. -@^system dependencies@> - -The term |print| is used instead of |write| when this program writes on -the |output| file, so that all such output can be easily deflected. - -@d print(#)==write(#) -@d print_ln(#)==write_ln(#) - -@p program OPL2OFM(@!pl_file,@!tfm_file,@!output); -const @<Constants in the outer block@>@/ -type @<Types in the outer block@>@/ -var @<Globals in the outer block@>@/ -procedure initialize; {this procedure gets things started properly} - var @<Local variables for initialization@>@/ - begin print_ln(banner);@/ - @<Set initial values@>@/ - end; - -@ The following parameters can be changed at compile time to extend or -reduce \.{PLtoTF}'s capacity. - -@<Constants...@>= -@!buf_size=60; {length of lines displayed in error messages} -@!max_header_bytes=100; {four times the maximum number of words allowed in - the \.{TFM} file header block, must be 1024 or less} -@!max_param_words=100; {the maximum number of \.{fontdimen} parameters allowed} -@!max_lig_steps=800000; - {maximum length of ligature program, must be at most $32767-257=32510$} -@!xmax_label=800001; -@!max_kerns=50000; {the maximum number of distinct kern values} -@!hash_size=130003; {preferably a prime number, a bit larger than the number - of character pairs in lig/kern steps} -@!hash_mult=16007; {another prime} -@!tfm_size=2000000; {maximum length of |tfm| data, in bytes} -@!lig_size=800000; {maximum length of |lig_kern| program, in words} -@!max_char=65535; {the largest character number in a font} -@!xmax_char=65536; {|max_char|+1} -@!xxmax_char=65537;{|max_char|+2} -@!xxxmax_char=65538;{|max_char|+3} -@!mem_size=262144; {|max_char|*4+8} -@!max_width=65535; {the largest character width number} -@!max_height=255; {the largest character height number} -@!max_depth=255; {the largest character depth number} -@!max_italic=255; {the largest character italic correction number} - -@ Here are some macros for common programming idioms. - -@d incr(#) == #:=#+1 {increase a variable by unity} -@d decr(#) == #:=#-1 {decrease a variable by unity} -@d do_nothing == {empty statement} - -@* Property list description of font metric data. -The idea behind \.{PL} files is that precise details about fonts, i.e., the -facts that are needed by typesetting routines like \TeX, sometimes have to -be supplied by hand. The nested property-list format provides a reasonably -convenient way to do this. - -A good deal of computation is necessary to parse and process a -\.{PL} file, so it would be inappropriate for \TeX\ itself to do this -every time it loads a font. \TeX\ deals only with the compact descriptions -of font metric data that appear in \.{TFM} files. Such data is so compact, -however, it is almost impossible for anybody but a computer to read it. -The purpose of \.{PLtoTF} is to convert from a human-oriented file of text -to a computer-oriented file of binary numbers. - -@<Glob...@>= -@!pl_file:text; - -@ @<Set init...@>= -reset(pl_file); - -@ A \.{PL} file is a list of entries of the form -$$\.{(PROPERTYNAME VALUE)}$$ -where the property name is one of a finite set of names understood by -this program, and the value may itself in turn be a property list. -The idea is best understood by looking at an example, so let's consider -a fragment of the \.{PL} file for a hypothetical font. -$$\vbox{\halign{\.{#}\hfil\cr -(FAMILY NOVA)\cr -(FACE F MIE)\cr -(CODINGSCHEME ASCII)\cr -(DESIGNSIZE D 10)\cr -(DESIGNUNITS D 18)\cr -(COMMENT A COMMENT IS IGNORED)\cr -(COMMENT (EXCEPT THIS ONE ISN'T))\cr -(COMMENT (ACTUALLY IT IS, EVEN THOUGH\cr -\qquad\qquad IT SAYS IT ISN'T))\cr -(FONTDIMEN\cr -\qquad (SLANT R -.25)\cr -\qquad (SPACE D 6)\cr -\qquad (SHRINK D 2)\cr -\qquad (STRETCH D 3)\cr -\qquad (XHEIGHT R 10.55)\cr -\qquad (QUAD D 18)\cr -\qquad )\cr -(LIGTABLE\cr -\qquad (LABEL C f)\cr -\qquad (LIG C f O 200)\cr -\qquad (SKIP D 1)\cr -\qquad (LABEL O 200)\cr -\qquad (LIG C i O 201)\cr -\qquad (KRN O 51 R 1.5)\cr -\qquad (/LIG C ? C f)\cr -\qquad (STOP)\cr -\qquad )\cr -(CHARACTER C f\cr -\qquad (CHARWD D 6)\cr -\qquad (CHARHT R 13.5)\cr -\qquad (CHARIC R 1.5)\cr -\qquad )\cr}}$$ -This example says that the font whose metric information is being described -belongs to the hypothetical -\.{NOVA} family; its face code is medium italic extended; -and the characters appear in ASCII code positions. The design size is 10 points, -and all other sizes in this \.{PL} file are given in units such that 18 units -equals the design size. The font is slanted with a slope of $-.25$ (hence the -letters actually slant backward---perhaps that is why the family name is -\.{NOVA}). The normal space between words is 6 units (i.e., one third of -the 18-unit design size), with glue that shrinks by 2 units or stretches by 3. -The letters for which accents don't need to be raised or lowered are 10.55 -units high, and one em equals 18 units. - -The example ligature table is a bit trickier. It specifies that the -letter \.f followed by another \.f is changed to code @'200, while -code @'200 followed by \.i is changed to @'201; presumably codes @'200 -and @'201 represent the ligatures `ff' and `ffi'. Moreover, in both cases -\.f and @'200, if the following character is the code @'51 (which is a -right parenthesis), an additional 1.5 units of space should be inserted -before the @'51. (The `\.{SKIP}~\.D~\.1' skips over one \.{LIG} or -\.{KRN} command, which in this case is the second \.{LIG}; in this way -two different ligature/kern programs can come together.) -Finally, if either \.f or @'200 is followed by a question mark, -the question mark is replaced by \.f and the ligature program is -started over. (Thus, the character pair `\.{f?}' would actually become -the ligature `ff', and `\.{ff?}' or `\.{f?f}' would become `fff'. To -avoid this restart procedure, the \.{/LIG} command could be replaced -by \.{/LIG>}; then `\.{f?} would become `f\kern0ptf' and `\.{f?f}' -would become `f\kern0ptff'.) - -Character \.f itself is 6 units wide and 13.5 units tall, in this example. -Its depth is zero (since \.{CHARDP} is not given), and its italic correction -is 1.5 units. - -@ The example above illustrates most of the features found in \.{PL} files. -Note that some property names, like \.{FAMILY} or \.{COMMENT}, take a -string as their value; this string continues until the first unmatched -right parenthesis. But most property names, like \.{DESIGNSIZE} and \.{SLANT} -and \.{LABEL}, take a number as their value. This number can be expressed in -a variety of ways, indicated by a prefixed code; \.D stands for decimal, -\.H for hexadecimal, \.O for octal, \.R for real, \.C for character, and -\.F for ``face.'' Other property names, like \.{LIG}, take two numbers as -their value. And still other names, like \.{FONTDIMEN} and \.{LIGTABLE} and -\.{CHARACTER}, have more complicated values that involve property lists. - -A property name is supposed to be used only in an appropriate property -list. For example, \.{CHARWD} shouldn't occur on the outer level or -within \.{FONTDIMEN}. - -The individual property-and-value pairs in a property list can appear in -any order. For instance, `\.{SHRINK}' precedes `\.{STRETCH}' in the above -example, although the \.{TFM} file always puts the stretch parameter first. -One could even give the information about characters like `\.f' before -specifying the number of units in the design size, or before specifying the -ligature and kerning table. However, the \.{LIGTABLE} itself is an exception -to this rule; the individual elements of the \.{LIGTABLE} property list -can be reordered only to a certain extent without changing the meaning -of that table. - -If property-and-value pairs are omitted, a default value is used. For example, -we have already noted that the default for \.{CHARDP} is zero. The default -for {\sl every\/} numeric value is, in fact, zero, unless otherwise stated -below. - -If the same property name is used more than once, \.{PLtoTF} will not notice -the discrepancy; it simply uses the final value given. Once again, however, the -\.{LIGTABLE} is an exception to this rule; \.{PLtoTF} will complain if there -is more than one label for some character. And of course many of the -entries in the \.{LIGTABLE} property list have the same property name. - -From these rules, you can guess (correctly) that \.{PLtoTF} operates in four -main steps. First it assigns the default values to all properties; then it scans -through the \.{PL} file, changing property values as new ones are seen; then -it checks the information and corrects any problems; and finally it outputs -the \.{TFM} file. - -@ Instead of relying on a hypothetical example, let's consider a complete -grammar for \.{PL} files. At the outer level, the following property names -are valid: - -\yskip\hang\.{CHECKSUM} (four-byte value). The value, which should be a -nonnegative integer less than $2^{32}$, is used to identify a particular -version of a font; it should match the check sum value stored with the font -itself. An explicit check sum of zero is used to bypass -check sum testing. If no checksum is specified in the \.{PL} file, -\.{PLtoTF} will compute the checksum that \MF\ would compute from the -same data. - -\yskip\hang\.{DESIGNSIZE} (numeric value, default is 10). The value, which -should be a real number in the range |1.0<=x<2048|, represents the default -amount by which all quantities will be scaled if the font is not loaded -with an `\.{at}' specification. For example, if one says -`\.{\\font\\A=cmr10 at 15pt}' in \TeX\ language, the design size in the \.{TFM} -file is ignored and effectively replaced by 15 points; but if one simply -says `\.{\\font\\A=cmr10}' the stated design size is used. This quantity is -always in units of printer's points. - -\yskip\hang\.{DESIGNUNITS} (numeric value, default is 1). The value -should be a positive real number; it says how many units equals the design -size (or the eventual `\.{at}' size, if the font is being scaled). For -example, suppose you have a font that has been digitized with 600 pixels per -em, and the design size is one em; then you could say `\.{(DESIGNUNITS R 600)}' -if you wanted to give all of your measurements in units of pixels. - -\yskip\hang\.{CODINGSCHEME} (string value, default is `\.{UNSPECIFIED}'). -The string should not contain parentheses, and its length must be less than 40. -It identifies the correspondence between the numeric codes and font characters. -(\TeX\ ignores this information, but other software programs make use of it.) - -\yskip\hang\.{FAMILY} (string value, default is `\.{UNSPECIFIED}'). -The string should not contain parentheses, and its length must be less than 20. -It identifies the name of the family to which this font belongs, e.g., -`\.{HELVETICA}'. (\TeX\ ignores this information; but it is needed, for -example, when converting \.{DVI} files to \.{PRESS} files for Xerox -equipment.) - -\yskip\hang\.{FACE} (one-byte value). This number, which must lie between -0 and 255 inclusive, is a subsidiary ident\-ifi\-ca\-tion of the font within its -family. For example, bold italic condensed fonts might have the same family name -as light roman extended fonts, differing only in their face byte. (\TeX\ -ignores this information; but it is needed, for example, when converting -\.{DVI} files to \.{PRESS} files for Xerox equipment.) - -\yskip\hang\.{SEVENBITSAFEFLAG} (string value, default is `\.{FALSE}'). The -value should start with either `\.T' (true) or `\.F' (false). If true, character -codes less than 128 cannot lead to codes of 128 or more via ligatures or -charlists or extensible characters. (\TeX82 ignores this flag, but older -versions of \TeX\ would only accept \.{TFM} files that were seven-bit safe.) -\.{PLtoTF} computes the correct value of this flag and gives an error message -only if a claimed ``true'' value is incorrect. - -\yskip\hang\.{HEADER} (a one-byte value followed by a four-byte value). -The one-byte value should be between 18 and a maximum limit that can be -raised or lowered depending on the compile-time setting of |max_header_bytes|. -The four-byte value goes into the header word whose index is the one-byte -value; for example, to set |header[18]:=1|, one may write -`\.{(HEADER D 18 O 1)}'. This notation is used for header information that -is presently unnamed. (\TeX\ ignores it.) - -\yskip\hang\.{FONTDIMEN} (property list value). See below for the names -allowed in this property list. - -\yskip\hang\.{LIGTABLE} (property list value). See below for the rules -about this special kind of property list. - -\yskip\hang\.{BOUNDARYCHAR} (integer value). If this character appears in -a \.{LIGTABLE} command, it matches ``end of word'' as well as itself. -If no boundary character is given and no \.{LABEL} \.{BOUNDARYCHAR} occurs -within \.{LIGTABLE}, word boundaries will not affect ligatures or kerning. - -\yskip\hang\.{CHARACTER}. The value is an integer followed by -a property list. The integer represents the number of a character that is -present in the font; the property list of a character is defined below. -The default is an empty property list. - -@ Numeric property list values can be given in various forms identified by -a prefixed letter. - -\yskip\hang\.C denotes an ASCII character, which should be a standard visible -character that is not a parenthesis. The numeric value will therefore be -between @'41 and @'176 but not @'50 or @'51. - -\yskip\hang\.D denotes a decimal integer, which must be nonnegative and -less than 256. (Use \.R for larger values or for negative values.) - -\yskip\hang\.F denotes a three-letter Xerox face code; the admissible codes -are \.{MRR}, \.{MIR}, \.{BRR}, \.{BIR}, \.{LRR}, \.{LIR}, \.{MRC}, \.{MIC}, -\.{BRC}, \.{BIC}, \.{LRC}, \.{LIC}, \.{MRE}, \.{MIE}, \.{BRE}, \.{BIE}, -\.{LRE}, and \.{LIE}, denoting the integers 0 to 17, respectively. - -\yskip\hang\.O denotes an unsigned octal integer, which must be less than -$2^{32}$, i.e., at most `\.{O 37777777777}'. - -\yskip\hang\.H denotes an unsigned hexadecimal integer, which must be less than -$2^{32}$, i.e., at most `\.{H FFFFFFFF}'. - -\yskip\hang\.R denotes a real number in decimal notation, optionally preceded -by a `\.+' or `\.-' sign, and optionally including a decimal point. The -absolute value must be less than 2048. - -@ The property names allowed in a \.{FONTDIMEN} property list correspond to -various \TeX\ parameters, each of which has a (real) numeric value. All -of the parameters except \.{SLANT} are in design units. The admissible -names are \.{SLANT}, \.{SPACE}, \.{STRETCH}, \.{SHRINK}, \.{XHEIGHT}, -\.{QUAD}, \.{EXTRASPACE}, \.{NUM1}, \.{NUM2}, \.{NUM3}, \.{DENOM1}, -\.{DENOM2}, \.{SUP1}, \.{SUP2}, \.{SUP3}, \.{SUB1}, \.{SUB2}, \.{SUPDROP}, -\.{SUBDROP}, \.{DELIM1}, \.{DELIM2}, and \.{AXISHEIGHT}, for parameters -1~to~22. The alternate names \.{DEFAULTRULETHICKNESS}, -\.{BIGOPSPACING1}, \.{BIGOPSPACING2}, \.{BIGOPSPACING3}, -\.{BIGOPSPACING4}, and \.{BIGOPSPACING5}, may also be used for parameters -8 to 13. - -The notation `\.{PARAMETER} $n$' provides another way to specify the -$n$th parameter; for example, `\.{(PARAMETER} \.{D 1 R -.25)}' is another way -to specify that the \.{SLANT} is $-0.25$. The value of $n$ must be positive -and less than |max_param_words|. - -@ The elements of a \.{CHARACTER} property list can be of six different types. - -\yskip\hang\.{CHARWD} (real value) denotes the character's width in -design units. - -\yskip\hang\.{CHARHT} (real value) denotes the character's height in -design units. - -\yskip\hang\.{CHARDP} (real value) denotes the character's depth in -design units. - -\yskip\hang\.{CHARIC} (real value) denotes the character's italic correction in -design units. - -\yskip\hang\.{NEXTLARGER} (integer value), specifies the character that -follows the present one in a ``charlist.'' The value must be the number of a -character in the font, and there must be no infinite cycles of supposedly -larger and larger characters. - -\yskip\hang\.{VARCHAR} (property list value), specifies an extensible character. -This option and \.{NEXTLARGER} are mutually exclusive; i.e., they cannot -both be used within the same \.{CHARACTER} list. - -\yskip\noindent -The elements of a \.{VARCHAR} property list are either \.{TOP}, \.{MID}, -\.{BOT} or \.{REP}; the values are integers, which must be zero or the number -of a character in the font. A zero value for \.{TOP}, \.{MID}, or \.{BOT} means -that the corresponding piece of the extensible character is absent. A nonzero -value, or a \.{REP} value of zero, denotes the character code used to make -up the top, middle, bottom, or replicated piece of an extensible character. - -@ A \.{LIGTABLE} property list contains elements of four kinds, specifying a -program in a simple command language that \TeX\ uses for ligatures and kerns. -If several \.{LIGTABLE} lists appear, they are effectively concatenated into -a single list. - -\yskip\hang\.{LABEL} (integer value) means that the program for the -stated character value starts here. The integer must be the number of a -character in the font; its \.{CHARACTER} property list must not have a -\.{NEXTLARGER} or \.{VARCHAR} field. At least one \.{LIG} or \.{KRN} step -must follow. - -\yskip\hang\.{LABEL} \.{BOUNDARYCHAR} means that the program for -beginning-of-word ligatures starts here. - -\yskip\hang\.{LIG} (two integer values). The instruction `\.{(LIG} $c$ $r$\.)' -means, ``If the next character is $c$, then insert character~$r$ and -possibly delete the current character and/or~$c$; -otherwise go on to the next instruction.'' -Characters $r$ and $c$ must be present in the font. \.{LIG} may be immediately -preceded or followed by a slash, and then immediately followed by \.> -characters not exceeding the number of slashes. Thus there are eight -possible forms: -$$\hbox to .8\hsize{\.{LIG}\hfil\.{/LIG}\hfil\.{/LIG>}\hfil -\.{LIG/}\hfil\.{LIG/>}\hfil\.{/LIG/}\hfil\.{/LIG/>}\hfil\.{/LIG/>>}}$$ -The slashes specify retention of the left or right original character; the -\.> signs specify passing over the result without further ligature processing. - -\yskip\hang\.{KRN} (an integer value and a real value). The instruction -`\.{(KRN} $c$ $r$\.)' means, ``If the next character is $c$, then insert -a blank space of width $r$ between the current character character and $c$; -otherwise go on to the next intruction.'' The value of $r$, which is in -units of the design size, is often negative. Character code $c$ must exist -in the font. - -\yskip\hang\.{STOP} (no value). This instruction ends a ligature/kern program. -It must follow either a \.{LIG} or \.{KRN} instruction, not a \.{LABEL} -or \.{STOP} or \.{SKIP}. - -\yskip\hang\.{SKIP} (value in the range |0..127|). This instruction specifies -continuation of a ligature/kern program after the specified number of \.{LIG} -or \.{KRN} has been skipped over. The number of subsequent \.{LIG} and \.{KRN} -instructions must therefore exceed this specified amount. - -@ In addition to all these possibilities, the property name \.{COMMENT} is -allowed in any property list. Such comments are ignored. - -@ So that is what \.{PL} files hold. The next question is, ``What about -\.{TFM} files?'' A complete answer to that question appears in the -documentation of the companion program, \.{TFtoPL}, so it will not -be repeated here. Suffice it to say that a \.{TFM} file stores all of the -relevant font information in a sequence of 8-bit bytes. The number of -bytes is always a multiple of 4, so we could regard the \.{TFM} file -as a sequence of 32-bit words; but \TeX\ uses the byte interpretation, -and so does \.{PLtoTF}. Note that the bytes are considered to be unsigned -numbers. - -@<Glob...@>= -@!tfm_file:packed file of 0..255; - -@ On some systems you may have to do something special to write a -packed file of bytes. For example, the following code didn't work -when it was first tried at Stanford, because packed files have to be -opened with a special switch setting on the \PASCAL\ that was used. -@^system dependencies@> - -@<Set init...@>= -rewrite(tfm_file); - -@* Basic input routines. -For the purposes of this program, a |byte| is an unsigned 16-bit quantity, -and an |ASCII_code| is an integer between @'40 and @'177. Such ASCII codes -correspond to one-character constants like \.{"A"} in \.{WEB} language. - -@<Types...@>= -@!byte=0..65535; {unsigned sixteen-bit quantity} -@!ASCII_code=@'40..@'177; {standard ASCII code numbers} - -@ One of the things \.{PLtoTF} has to do is convert characters of strings -to ASCII form, since that is the code used for the family name and the -coding scheme in a \.{TFM} file. An array |xord| is used to do the -conversion from |char|; the method below should work with little or no change -on most \PASCAL\ systems. -@^system dependencies@> - -@d first_ord=0 {ordinal number of the smallest element of |char|} -@d last_ord=127 {ordinal number of the largest element of |char|} - -@<Global...@>= -@!xord:array[char] of ASCII_code; {conversion table} - -@ @<Local variables for init...@>= -@!k:integer; {all-purpose initialization index} - -@ Characters that should not appear in \.{PL} files (except in comments) -are mapped into @'177. - -@d invalid_code=@'177 {code deserving an error message} - -@<Set init...@>= -for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code; -xord[' ']:=" "; xord['!']:="!"; xord['"']:=""""; xord['#']:="#"; -xord['$']:="$"; xord['%']:="%"; xord['&']:="&"; xord['''']:="'"; -xord['(']:="("; xord[')']:=")"; xord['*']:="*"; xord['+']:="+"; xord[',']:=","; -xord['-']:="-"; xord['.']:="."; xord['/']:="/"; xord['0']:="0"; xord['1']:="1"; -xord['2']:="2"; xord['3']:="3"; xord['4']:="4"; xord['5']:="5"; xord['6']:="6"; -xord['7']:="7"; xord['8']:="8"; xord['9']:="9"; xord[':']:=":"; xord[';']:=";"; -xord['<']:="<"; xord['=']:="="; xord['>']:=">"; xord['?']:="?"; -xord['@@']:="@@"; xord['A']:="A"; xord['B']:="B"; xord['C']:="C"; -xord['D']:="D"; xord['E']:="E"; xord['F']:="F"; xord['G']:="G"; xord['H']:="H"; -xord['I']:="I"; xord['J']:="J"; xord['K']:="K"; xord['L']:="L"; xord['M']:="M"; -xord['N']:="N"; xord['O']:="O"; xord['P']:="P"; xord['Q']:="Q"; xord['R']:="R"; -xord['S']:="S"; xord['T']:="T"; xord['U']:="U"; xord['V']:="V"; xord['W']:="W"; -xord['X']:="X"; xord['Y']:="Y"; xord['Z']:="Z"; xord['[']:="["; xord['\']:="\"; -xord[']']:="]"; xord['^']:="^"; xord['_']:="_"; xord['`']:="`"; xord['a']:="a"; -xord['b']:="b"; xord['c']:="c"; xord['d']:="d"; xord['e']:="e"; xord['f']:="f"; -xord['g']:="g"; xord['h']:="h"; xord['i']:="i"; xord['j']:="j"; xord['k']:="k"; -xord['l']:="l"; xord['m']:="m"; xord['n']:="n"; xord['o']:="o"; xord['p']:="p"; -xord['q']:="q"; xord['r']:="r"; xord['s']:="s"; xord['t']:="t"; xord['u']:="u"; -xord['v']:="v"; xord['w']:="w"; xord['x']:="x"; xord['y']:="y"; xord['z']:="z"; -xord['{']:="{"; xord['|']:="|"; xord['}']:="}"; xord['~']:="~"; - -@ In order to help catch errors of badly nested parentheses, \.{PLtoTF} -assumes that the user will begin each line with a number of blank spaces equal -to some constant times the number of open parentheses at the beginning of -that line. However, the program doesn't know in advance what the constant -is, nor does it want to print an error message on every line for a user -who has followed no consistent pattern of indentation. - -Therefore the following strategy is adopted: If the user has been consistent -with indentation for ten or more lines, an indentation error will be -reported. The constant of indentation is reset on every line that should -have nonzero indentation. - -@<Glob...@>= -@!line:integer; {the number of the current line} -@!good_indent:integer; {the number of lines since the last bad indentation} -@!indent: integer; {the number of spaces per open parenthesis, zero if unknown} -@!level: integer; {the current number of open parentheses} - -@ @<Set init...@>= -line:=0; good_indent:=0; indent:=0; level:=0; - -@ The input need not really be broken into lines of any maximum length, and -we could read it character by character without any buffering. But we shall -place it into a small buffer so that offending lines can be displayed in error -messages. - -@<Glob...@>= -@!left_ln,@!right_ln:boolean; {are the left and right ends of the buffer - at end-of-line marks?} -@!limit:0..buf_size; {position of the last character present in the buffer} -@!loc:0..buf_size; {position of the last character read in the buffer} -@!buffer:array[1..buf_size] of char; -@!input_has_ended:boolean; {there is no more input to read} - -@ @<Set init...@>= -limit:=0; loc:=0; left_ln:=true; right_ln:=true; input_has_ended:=false; - -@ Just before each \.{CHARACTER} property list is evaluated, the character -code is printed in octal notation. Up to eight such codes appear on a line; -so we have a variable to keep track of how many are currently there. - -@<Glob...@>= -@!chars_on_line:0..8; {the number of characters printed on the current line} - -@ @<Set init...@>= -chars_on_line:=0; - -@ The following routine prints an error message and an indication of -where the error was detected. The error message should not include any -final punctuation, since this procedure supplies its own. - -@d err_print(#)==begin if chars_on_line>0 then print_ln(' '); - print(#); show_error_context; - end - -@p procedure show_error_context; {prints the current scanner location} -var k:0..buf_size; {an index into |buffer|} -begin print_ln(' (line ',line:1,').'); -if not left_ln then print('...'); -for k:=1 to loc do print(buffer[k]); {print the characters already scanned} -print_ln(' '); -if not left_ln then print(' '); -for k:=1 to loc do print(' '); {space out the second line} -for k:=loc+1 to limit do print(buffer[k]); {print the characters yet unseen} -if right_ln then print_ln(' ')@+else print_ln('...'); -chars_on_line:=0; -end; - -@ Here is a procedure that does the right thing when we are done -reading the present contents of the buffer. It keeps |buffer[buf_size]| -empty, in order to avoid range errors on certain \PASCAL\ compilers. - -An infinite sequence of right parentheses is placed at the end of the -file, so that the program is sure to get out of whatever level of nesting -it is in. - -On some systems it is desirable to modify this code so that tab marks -in the buffer are replaced by blank spaces. (Simply setting -|xord[chr(@'11)]:=" "| would not work; for example, two-line -error messages would not come out properly aligned.) -@^system dependencies@> - -@p procedure fill_buffer; -begin left_ln:=right_ln; limit:=0; loc:=0; -if left_ln then begin - if line>0 then read_ln(pl_file); - incr(line); - end; -if eof(pl_file) then begin - limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true; - end -else begin - while (limit<buf_size-1)and(not eoln(pl_file)) do begin - incr(limit); read(pl_file,buffer[limit]); - end; - buffer[limit+1]:=' '; right_ln:=eoln(pl_file); - if left_ln then @<Set |loc| to the number of leading blanks in - the buffer, and check the indentation@>; - end; -end; - -@ The interesting part about |fill_buffer| is the part that learns what -indentation conventions the user is following, if any. - -@d bad_indent(#)==begin if good_indent>=10 then err_print(#); - good_indent:=0; indent:=0; - end - -@<Set |loc|...@>= -begin while (loc<limit)and(buffer[loc+1]=' ') do incr(loc); -if loc<limit then begin - if level=0 then - if loc=0 then incr(good_indent) - else bad_indent('Warning: Indented line occurred at level zero') -@.Warning: Indented line...@> - else if indent=0 then - if loc mod level=0 then begin - indent:=loc div level; good_indent:=1; - end - else good_indent:=0 - else if indent*level=loc then incr(good_indent) - else bad_indent('Warning: Inconsistent indentation; ', -@.Warning: Inconsistent indentation...@> - 'you are at parenthesis level ',level:1); - end; -end - -@* Basic scanning routines. -The global variable |cur_char| holds the ASCII code corresponding to the -character most recently read from the input buffer, or to a character that -has been substituted for the real one. - -@<Global...@>= -@!cur_char:ASCII_code; {we have just read this} - -@ Here is a procedure that sets |cur_char| to an ASCII code for the -next character of input, if that character is a letter or digit or slash -or \.>. Otherwise -it sets |cur_char:=" "|, and the input system will be poised to reread the -character that was rejected, whether or not it was a space. -Lower case letters are converted to upper case. - -@p procedure get_keyword_char; -begin while (loc=limit)and(not right_ln) do fill_buffer; -if loc=limit then cur_char:=" " {end-of-line counts as a delimiter} -else begin - cur_char:=xord[buffer[loc+1]]; - if cur_char>="a" then cur_char:=cur_char-@'40; - if ((cur_char>="0")and(cur_char<="9")) then incr(loc) - else if ((cur_char>="A")and(cur_char<="Z")) then incr(loc) - else if cur_char="/" then incr(loc) - else if cur_char=">" then incr(loc) - else cur_char:=" "; - end; -end; - -@ The following procedure sets |cur_char| to the next character code, -and converts lower case to upper case. If the character is a left or -right parenthesis, it will not be ``digested''; the character will -be read again and again, until the calling routine does something -like `|incr(loc)|' to get past it. Such special treatment of parentheses -insures that the structural information they contain won't be lost in -the midst of other error recovery operations. - -@d backup==begin if (cur_char>")")or(cur_char<"(") then decr(loc); - end {undoes the effect of |get_next|} - -@p procedure get_next; {sets |cur_char| to next, balks at parentheses} -begin while loc=limit do fill_buffer; -incr(loc); cur_char:=xord[buffer[loc]]; -if cur_char>="a" then - if cur_char<="z" then cur_char:=cur_char-@'40 {uppercasify} - else begin - if cur_char=invalid_code then begin - err_print('Illegal character in the file'); -@.Illegal character...@> - cur_char:="?"; - end; - end -else if (cur_char<=")")and(cur_char>="(") then decr(loc); -end; - -@ The next procedure is used to ignore the text of a comment, or to pass over -erroneous material. As such, it has the privilege of passing parentheses. -It stops after the first right parenthesis that drops the level below -the level in force when the procedure was called. - -@p procedure skip_to_end_of_item; -var l:integer; {initial value of |level|} -begin l:=level; -while level>=l do begin - while loc=limit do fill_buffer; - incr(loc); - if buffer[loc]=')' then decr(level) - else if buffer[loc]='(' then incr(level); - end; -if input_has_ended then err_print('File ended unexpectedly: No closing ")"'); -@.File ended unexpectedly...@> -cur_char:=" "; {now the right parenthesis has been read and digested} -end; - -@ Sometimes we merely want to skip past characters in the input until we -reach a left or a right parenthesis. For example, we do this whenever we -have finished scanning a property value and we hope that a right parenthesis -is next (except for possible blank spaces). - -@d skip_to_paren==repeat get_next@;@+ until (cur_char="(")or(cur_char=")") -@d skip_error(#)==begin err_print(#); skip_to_paren; - end {this gets to the right parenthesis if something goes wrong} -@d flush_error(#)==begin err_print(#); skip_to_end_of_item; - end {this gets past the right parenthesis if something goes wrong} - -@ After a property value has been scanned, we want to move just past the -right parenthesis that should come next in the input (except for possible -blank spaces). - -@p procedure finish_the_property; {do this when the value has been scanned} -begin while cur_char=" " do get_next; -if cur_char<>")" then err_print('Junk after property value will be ignored'); -@.Junk after property value...@> -skip_to_end_of_item; -end; - -@* Scanning property names. -We have to figure out the meaning of names that appear in the \.{PL} file, -by looking them up in a dictionary of known keywords. Keyword number $n$ -appears in locations |start[n]| through |start[n+1]-1| of an array called -|dictionary|. - -@d max_name_index=300 {upper bound on the number of keywords} -@d max_letters=3000 {upper bound on the total length of all keywords} - -@<Global...@>= -@!start:array[1..max_name_index] of 0..max_letters; -@!dictionary:array[0..max_letters] of ASCII_code; -@!start_ptr:0..max_name_index; {the first available place in |start|} -@!dict_ptr:0..max_letters; {the first available place in |dictionary|} - -@ @<Set init...@>= -start_ptr:=1; start[1]:=0; dict_ptr:=0; - -@ When we are looking for a name, we put it into the |cur_name| array. -When we have found it, the corresponding |start| index will go into -the global variable |name_ptr|. - -@d longest_name=20 {length of \.{DEFAULTRULETHICKNESS}} - -@<Glob...@>= -@!cur_name:array[1..longest_name] of ASCII_code; {a name to look up} -@!name_length:0..longest_name; {its length} -@!name_ptr:0..max_name_index; {its ordinal number in the dictionary} - -@ A conventional hash table with linear probing (cf.\ Algorithm 6.4L -in {\sl The Art of Computer Pro\-gram\-ming\/}) is used for the dictionary -operations. If |nhash[h]=0|, the table position is empty, otherwise |nhash[h]| -points into the |start| array. - -@d hash_prime=307 {size of the hash table} - -@<Glob...@>= -@!nhash:array[0..hash_prime-1] of 0..max_name_index; -@!cur_hash:0..hash_prime-1; {current position in the hash table} - -@ @<Local...@>= -@!h:0..hash_prime-1; {runs through the hash table} - -@ @<Set init...@>= -for h:=0 to hash_prime-1 do nhash[h]:=0; - -@ Since there is no chance of the hash table overflowing, the procedure -is very simple. After |lookup| has done its work, |cur_hash| will point -to the place where the given name was found, or where it should be inserted. - -@p procedure lookup; {finds |cur_name| in the dictionary} -var k:0..longest_name; {index into |cur_name|} -@!j:0..max_letters; {index into |dictionary|} -@!not_found:boolean; {clumsy thing necessary to avoid |goto| statement} -@!cur_hash_reset:boolean; -begin @<Compute the hash code, |cur_hash|, for |cur_name|@>; -not_found:=true; -cur_hash_reset:=false; -while not_found do begin - if (cur_hash=0) and (cur_hash_reset) then - not_found:=false - else begin - if cur_hash=0 then begin - cur_hash:=hash_prime-1; - cur_hash_reset:=true - end - else decr(cur_hash); - if nhash[cur_hash]=0 then not_found:=false - else begin - j:=start[nhash[cur_hash]]; - if start[nhash[cur_hash]+1]=j+name_length then begin - not_found:=false; - for k:=1 to name_length do - if dictionary[j+k-1]<>cur_name[k] then not_found:=true; - end - end - end - end; -name_ptr:=nhash[cur_hash]; -end; - -@ @<Compute the hash...@>= -cur_hash:=cur_name[1]; -for k:=2 to name_length do - cur_hash:=(cur_hash+cur_hash+cur_name[k]) mod hash_prime - -@ The ``meaning'' of the keyword that begins at |start[k]| in the -dictionary is kept in |equiv[k]|. The numeric |equiv| codes are given -symbolic meanings by the following definitions. - -@d comment_code=0 -@d check_sum_code=1 -@d design_size_code=2 -@d design_units_code=3 -@d coding_scheme_code=4 -@d family_code=5 -@d face_code=6 -@d seven_bit_safe_flag_code=7 -@d header_code= 8 -@d font_dimen_code=9 -@d lig_table_code=10 -@d boundary_char_code=11 -@d font_dir_code=14 -@d n_font_dir_code=15 -@d character_code=16 -@d parameter_code=30 -@d char_info_code=70 -@d width=1 -@d height=2 -@d depth=3 -@d italic=4 -@d sec_width=5 -@d sec_height=6 -@d sec_depth=7 -@d sec_italic=8 -@d accent=9 -@d prim_top_axis=10 -@d prim_top_axis_bis=11 -@d prim_bot_axis=12 -@d prim_bot_axis_bis=13 -@d prim_mid_hor=14 -@d prim_mid_vert=15 -@d prim_base_slant=16 -@d sec_top_axis=17 -@d sec_top_axis_bis=18 -@d sec_bot_axis=19 -@d sec_bot_axis_bis=20 -@d sec_mid_hor=21 -@d sec_mid_vert=22 -@d sec_base_slant=23 -@d char_wd_code=char_info_code+width -@d char_ht_code=char_info_code+height -@d char_dp_code=char_info_code+depth -@d char_ic_code=char_info_code+italic -@d sec_width_code=char_info_code+sec_width -@d sec_height_code=char_info_code+sec_height -@d sec_depth_code=char_info_code+sec_depth -@d sec_italic_code=char_info_code+sec_italic -@d accent_code=char_info_code+accent -@d prim_top_axis_code=char_info_code+prim_top_axis -@d prim_top_axis_bis_code=char_info_code+prim_top_axis_bis -@d prim_bot_axis_code=char_info_code+prim_bot_axis -@d prim_bot_axis_bis_code=char_info_code+prim_bot_axis_bis -@d prim_mid_hor_code=char_info_code+prim_mid_hor -@d prim_mid_vert_code=char_info_code+prim_mid_vert -@d prim_base_slant_code=char_info_code+prim_base_slant -@d sec_top_axis_code=char_info_code+sec_top_axis -@d sec_top_axis_bis_code=char_info_code+sec_top_axis_bis -@d sec_bot_axis_code=char_info_code+sec_bot_axis -@d sec_bot_axis_bis_code=char_info_code+sec_bot_axis_bis -@d sec_mid_hor_code=char_info_code+sec_mid_hor -@d sec_mid_vert_code=char_info_code+sec_mid_vert -@d sec_base_slant_code=char_info_code+sec_base_slant -@d next_larger_code=100 -@d var_char_code=102 -@d label_code=130 -@d stop_code=131 -@d skip_code=132 -@d krn_code=133 -@d lig_code=134 -@d ofm_level_code=140 -@d char_repeat_code=150 -@d char_ivalue_code=151 -@d char_fvalue_code=152 -@d char_mvalue_code=153 -@d char_rule_code=154 -@d char_glue_code=155 -@d char_penalty_code=156 -@d font_rule_code=160 -@d rule_code=161 -@d rule_width_code=162 -@d rule_height_code=163 -@d rule_depth_code=164 -@d font_glue_code=170 -@d glue_code=171 -@d glue_type_code=172 -@d glue_stretch_order_code=173 -@d glue_shrink_order_code=174 -@d glue_width_code=175 -@d glue_stretch_code=176 -@d glue_shrink_code=177 -@d glue_char_code=178 -@d glue_rule_code=179 -@d order_unit_code=181 -@d order_fi_code=182 -@d order_fil_code=183 -@d order_fill_code=184 -@d order_filll_code=185 -@d type_normal_code=186 -@d type_aleaders_code=187 -@d type_cleaders_code=188 -@d type_xleaders_code=189 -@d font_penalty_code=190 -@d penalty_code=191 -@d penalty_val_code=192 -@d font_mvalue_code=200 -@d mvalue_code=201 -@d mvalue_val_code=202 -@d font_fvalue_code=210 -@d fvalue_code=211 -@d fvalue_val_code=212 -@d font_ivalue_code=220 -@d ivalue_code=221 -@d ivalue_val_code=222 -@d clabel_code=231 -@d cpen_code=232 -@d cglue_code=233 -@d cpenglue_code=234 -@d ckrn_code=235 -@d TL_dir_code=240 -@d LT_dir_code=241 -@d TR_dir_code=242 -@d LB_dir_code=243 -@d BL_dir_code=244 -@d RT_dir_code=245 -@d BR_dir_code=246 -@d RB_dir_code=247 - - -@<Glo...@>= -@!equiv:array[0..max_name_index] of byte; -@!cur_code:byte; {equivalent most recently found in |equiv|} - -@ We have to get the keywords into the hash table and into the dictionary in -the first place (sigh). The procedure that does this has the desired -|equiv| code as a parameter. In order to facilitate \.{WEB} macro writing -for the initialization, the keyword being initialized is placed into the -last positions of |cur_name|, instead of the first positions. - -@p procedure enter_name(v:byte); {|cur_name| goes into the dictionary} -var k:0..longest_name; -begin for k:=1 to name_length do - cur_name[k]:=cur_name[k+longest_name-name_length]; -{now the name has been shifted into the correct position} -lookup; {this sets |cur_hash| to the proper insertion place} -nhash[cur_hash]:=start_ptr; equiv[start_ptr]:=v; -for k:=1 to name_length do - begin dictionary[dict_ptr]:=cur_name[k]; incr(dict_ptr); - end; -incr(start_ptr); start[start_ptr]:=dict_ptr; -end; - -@ Here are the macros to load a name of up to 20 letters into the -dictionary. For example, the macro |load5| is used for five-letter keywords. - -@d tail(#)==enter_name(#) -@d t20(#)==cur_name[20]:=#;tail -@d t19(#)==cur_name[19]:=#;t20 -@d t18(#)==cur_name[18]:=#;t19 -@d t17(#)==cur_name[17]:=#;t18 -@d t16(#)==cur_name[16]:=#;t17 -@d t15(#)==cur_name[15]:=#;t16 -@d t14(#)==cur_name[14]:=#;t15 -@d t13(#)==cur_name[13]:=#;t14 -@d t12(#)==cur_name[12]:=#;t13 -@d t11(#)==cur_name[11]:=#;t12 -@d t10(#)==cur_name[10]:=#;t11 -@d t9(#)==cur_name[9]:=#;t10 -@d t8(#)==cur_name[8]:=#;t9 -@d t7(#)==cur_name[7]:=#;t8 -@d t6(#)==cur_name[6]:=#;t7 -@d t5(#)==cur_name[5]:=#;t6 -@d t4(#)==cur_name[4]:=#;t5 -@d t3(#)==cur_name[3]:=#;t4 -@d t2(#)==cur_name[2]:=#;t3 -@d t1(#)==cur_name[1]:=#;t2 -@d load2==name_length:=2;t19 -@d load3==name_length:=3;t18 -@d load4==name_length:=4;t17 -@d load5==name_length:=5;t16 -@d load6==name_length:=6;t15 -@d load7==name_length:=7;t14 -@d load8==name_length:=8;t13 -@d load9==name_length:=9;t12 -@d load10==name_length:=10;t11 -@d load11==name_length:=11;t10 -@d load12==name_length:=12;t9 -@d load13==name_length:=13;t8 -@d load14==name_length:=14;t7 -@d load15==name_length:=15;t6 -@d load16==name_length:=16;t5 -@d load17==name_length:=17;t4 -@d load18==name_length:=18;t3 -@d load19==name_length:=19;t2 -@d load20==name_length:=20;t1 - -@ (Thank goodness for keyboard macros in the text editor used to create this -\.{WEB} file.) - -@<Enter all of the names and their equivalents, except the parameter names@>= -equiv[0]:=comment_code; {this is used after unknown keywords} -load8("C")("H")("E")("C")("K")("S")("U")("M")(check_sum_code);@/ -load10("D")("E")("S")("I")("G")("N")("S")("I")("Z")("E")(design_size_code);@/ -load11("D")("E")("S")("I")("G")("N") - ("U")("N")("I")("T")("S")(design_units_code);@/ -load12("C")("O")("D")("I")("N")("G") - ("S")("C")("H")("E")("M")("E")(coding_scheme_code);@/ -load6("F")("A")("M")("I")("L")("Y")(family_code);@/ -load4("F")("A")("C")("E")(face_code);@/ -load16("S")("E")("V")("E")("N")("B")("I")("T")@/@t\hskip2em@> - ("S")("A")("F")("E")("F")("L")("A")("G")(seven_bit_safe_flag_code);@/ -load6("H")("E")("A")("D")("E")("R")(header_code);@/ -load9("F")("O")("N")("T")("D")("I")("M")("E")("N")(font_dimen_code);@/ -load8("L")("I")("G")("T")("A")("B")("L")("E")(lig_table_code);@/ -load12("B")("O")("U")("N")("D")("A")("R")("Y")("C")("H")("A")("R") - (boundary_char_code);@/ -load9("C")("H")("A")("R")("A")("C")("T")("E")("R")(character_code);@/ -load9("P")("A")("R")("A")("M")("E")("T")("E")("R")(parameter_code);@/ -load6("C")("H")("A")("R")("W")("D")(char_wd_code);@/ -load6("C")("H")("A")("R")("H")("T")(char_ht_code);@/ -load6("C")("H")("A")("R")("D")("P")(char_dp_code);@/ -load6("C")("H")("A")("R")("I")("C")(char_ic_code);@/ -load5("S")("E")("C")("W")("D")(sec_width_code);@/ -load5("S")("E")("C")("H")("T")(sec_height_code);@/ -load5("S")("E")("C")("D")("P")(sec_depth_code);@/ -load5("S")("E")("C")("I")("C")(sec_italic_code);@/ -load6("A")("C")("C")("E")("N")("T")(accent_code);@/ -load11("P")("R")("I")("M")("T")("O")("P")("A")("X")("I")("S")(prim_top_axis_code);@/ -load14("P")("R")("I")("M")("T")("O")("P")("A")("X")("I")("S")("B")("I")("S")(prim_top_axis_bis_code);@/ -load11("P")("R")("I")("M")("B")("O")("T")("A")("X")("I")("S")(prim_bot_axis_code);@/ -load14("P")("R")("I")("M")("B")("O")("T")("A")("X")("I")("S")("B")("I")("S")(prim_bot_axis_bis_code);@/ -load10("P")("R")("I")("M")("M")("I")("D")("H")("O")("R")(prim_mid_hor_code);@/ -load10("P")("R")("I")("M")("M")("I")("D")("V")("E")("R")(prim_mid_vert_code);@/ -load13("P")("R")("I")("M")("B")("A")("S")("E")("S")("L")("A")("N")("T")(prim_base_slant_code);@/ -load10("S")("E")("C")("T")("O")("P")("A")("X")("I")("S")(sec_top_axis_code);@/ -load13("S")("E")("C")("T")("O")("P")("A")("X")("I")("S")("B")("I")("S")(sec_top_axis_bis_code);@/ -load10("S")("E")("C")("B")("O")("T")("A")("X")("I")("S")(sec_bot_axis_code);@/ -load13("S")("E")("C")("B")("O")("T")("A")("X")("I")("S")("B")("I")("S")(sec_bot_axis_bis_code);@/ -load9("S")("E")("C")("M")("I")("D")("H")("O")("R")(sec_mid_hor_code);@/ -load9("S")("E")("C")("M")("I")("D")("V")("E")("R")(sec_mid_vert_code);@/ -load12("S")("E")("C")("B")("A")("S")("E")("S")("L")("A")("N")("T")(sec_base_slant_code);@/ -load10("N")("E")("X")("T")("L")("A")("R")("G")("E")("R")(next_larger_code);@/ -load7("V")("A")("R")("C")("H")("A")("R")(var_char_code);@/ -load3("T")("O")("P")(var_char_code+1);@/ -load3("M")("I")("D")(var_char_code+2);@/ -load3("B")("O")("T")(var_char_code+3);@/ -load3("R")("E")("P")(var_char_code+4);@/ -load3("E")("X")("T")(var_char_code+4); {compatibility with older \.{PL} format} -load7("C")("O")("M")("M")("E")("N")("T")(comment_code);@/ -load5("L")("A")("B")("E")("L")(label_code);@/ -load4("S")("T")("O")("P")(stop_code);@/ -load4("S")("K")("I")("P")(skip_code);@/ -load3("K")("R")("N")(krn_code);@/ -load3("L")("I")("G")(lig_code);@/ -load4("/")("L")("I")("G")(lig_code+2);@/ -load5("/")("L")("I")("G")(">")(lig_code+6);@/ -load4("L")("I")("G")("/")(lig_code+1);@/ -load5("L")("I")("G")("/")(">")(lig_code+5);@/ -load5("/")("L")("I")("G")("/")(lig_code+3);@/ -load6("/")("L")("I")("G")("/")(">")(lig_code+7);@/ -load7("/")("L")("I")("G")("/")(">")(">")(lig_code+11);@/ -load6("C")("L")("A")("B")("E")("L")(clabel_code);@/ -load4("C")("P")("E")("N")(cpen_code);@/ -load5("C")("G")("L")("U")("E")(cglue_code);@/ -load8("C")("P")("E")("N")("G")("L")("U")("E")(cpenglue_code);@/ -load4("C")("K")("R")("N")(ckrn_code);@/ -load8("O")("F")("M")("L")("E")("V")("E")("L")(ofm_level_code);@/ -load7("F")("O")("N")("T")("D")("I")("R")(font_dir_code);@/ -load8("N")("F")("O")("N")("T")("D")("I")("R")(n_font_dir_code);@/ -load10("C")("H")("A")("R")("R")("E")("P")("E")("A")("T")(char_repeat_code);@/ -load10("C")("H")("A")("R")("I")("V")("A")("L")("U")("E")(char_ivalue_code);@/ -load10("C")("H")("A")("R")("F")("V")("A")("L")("U")("E")(char_fvalue_code);@/ -load10("C")("H")("A")("R")("M")("V")("A")("L")("U")("E")(char_mvalue_code);@/ -load8("C")("H")("A")("R")("R")("U")("L")("E")(char_rule_code);@/ -load8("C")("H")("A")("R")("G")("L")("U")("E")(char_glue_code);@/ -load11("C")("H")("A")("R")("P")("E")("N")("A")("L")("T")("Y")(char_penalty_code);@/ -load8("F")("O")("N")("T")("R")("U")("L")("E")(font_rule_code);@/ -load4("R")("U")("L")("E")(rule_code);@/ -load6("R")("U")("L")("E")("W")("D")(rule_width_code);@/ -load6("R")("U")("L")("E")("H")("T")(rule_height_code);@/ -load6("R")("U")("L")("E")("D")("P")(rule_depth_code);@/ -load8("F")("O")("N")("T")("G")("L")("U")("E")(font_glue_code);@/ -load4("G")("L")("U")("E")(glue_code);@/ -load8("G")("L")("U")("E")("T")("Y")("P")("E")(glue_type_code);@/ -load16("G")("L")("U")("E")("S")("T")("R")("E")("T")("C")("H")("O")("R")("D")("E")("R")(glue_stretch_order_code);@/ -load15("G")("L")("U")("E")("S")("H")("R")("I")("N")("K")("O")("R")("D")("E")("R")(glue_shrink_order_code);@/ -load8("G")("L")("U")("E")("R")("U")("L")("E")(glue_rule_code);@/ -load8("G")("L")("U")("E")("C")("H")("A")("R")(glue_char_code);@/ -load6("G")("L")("U")("E")("W")("D")(glue_width_code);@/ -load11("G")("L")("U")("E")("S")("T")("R")("E")("T")("C")("H")(glue_stretch_code);@/ -load10("G")("L")("U")("E")("S")("H")("R")("I")("N")("K")(glue_shrink_code);@/ -load4("U")("N")("I")("T")(order_unit_code);@/ -load2("F")("I")(order_fi_code);@/ -load3("F")("I")("L")(order_fil_code);@/ -load4("F")("I")("L")("L")(order_fill_code);@/ -load5("F")("I")("L")("L")("L")(order_filll_code);@/ -load6("N")("O")("R")("M")("A")("L")(type_normal_code);@/ -load8("A")("L")("E")("A")("D")("E")("R")("S")(type_aleaders_code);@/ -load8("C")("L")("E")("A")("D")("E")("R")("S")(type_cleaders_code);@/ -load8("X")("L")("E")("A")("D")("E")("R")("S")(type_xleaders_code);@/ -load11("F")("O")("N")("T")("P")("E")("N")("A")("L")("T")("Y")(font_penalty_code);@/ -load7("P")("E")("N")("A")("L")("T")("Y")(penalty_code);@/ -load10("P")("E")("N")("A")("L")("T")("Y")("V")("A")("L")(penalty_val_code);@/ -load10("F")("O")("N")("T")("M")("V")("A")("L")("U")("E")(font_mvalue_code);@/ -load6("M")("V")("A")("L")("U")("E")(mvalue_code);@/ -load9("M")("V")("A")("L")("U")("E")("V")("A")("L")(mvalue_val_code);@/ -load10("F")("O")("N")("T")("F")("V")("A")("L")("U")("E")(font_fvalue_code);@/ -load6("F")("V")("A")("L")("U")("E")(fvalue_code);@/ -load9("F")("V")("A")("L")("U")("E")("V")("A")("L")(fvalue_val_code);@/ -load10("F")("O")("N")("T")("I")("V")("A")("L")("U")("E")(font_ivalue_code);@/ -load6("I")("V")("A")("L")("U")("E")(ivalue_code);@/ -load9("I")("V")("A")("L")("U")("E")("V")("A")("L")(ivalue_val_code);@/ -load2("T")("L")(TL_dir_code); -load2("L")("T")(LT_dir_code); -load2("T")("R")(TR_dir_code); -load2("L")("B")(LB_dir_code); -load2("B")("L")(BL_dir_code); -load2("R")("T")(RT_dir_code); -load2("B")("R")(BR_dir_code); -load2("R")("B")(RB_dir_code); - -@ @<Enter the parameter names@>= -load5("S")("L")("A")("N")("T")(parameter_code+1);@/ -load5("S")("P")("A")("C")("E")(parameter_code+2);@/ -load7("S")("T")("R")("E")("T")("C")("H")(parameter_code+3);@/ -load6("S")("H")("R")("I")("N")("K")(parameter_code+4);@/ -load7("X")("H")("E")("I")("G")("H")("T")(parameter_code+5);@/ -load4("Q")("U")("A")("D")(parameter_code+6);@/ -load10("E")("X")("T")("R")("A")("S")("P")("A")("C")("E")(parameter_code+7);@/ -load4("N")("U")("M")("1")(parameter_code+8);@/ -load4("N")("U")("M")("2")(parameter_code+9);@/ -load4("N")("U")("M")("3")(parameter_code+10);@/ -load6("D")("E")("N")("O")("M")("1")(parameter_code+11);@/ -load6("D")("E")("N")("O")("M")("2")(parameter_code+12);@/ -load4("S")("U")("P")("1")(parameter_code+13);@/ -load4("S")("U")("P")("2")(parameter_code+14);@/ -load4("S")("U")("P")("3")(parameter_code+15);@/ -load4("S")("U")("B")("1")(parameter_code+16);@/ -load4("S")("U")("B")("2")(parameter_code+17);@/ -load7("S")("U")("P")("D")("R")("O")("P")(parameter_code+18);@/ -load7("S")("U")("B")("D")("R")("O")("P")(parameter_code+19);@/ -load6("D")("E")("L")("I")("M")("1")(parameter_code+20);@/ -load6("D")("E")("L")("I")("M")("2")(parameter_code+21);@/ -load10("A")("X")("I")("S")("H")("E")("I")("G")("H")("T")(parameter_code+22);@/ -load20("D")("E")("F")("A")("U")("L")("T")("R")("U")("L")("E")@/@t\hskip2em@> - ("T")("H")("I")("C")("K")("N")("E")("S")("S")(parameter_code+8);@/ -load13("B")("I")("G")("O")("P") - ("S")("P")("A")("C")("I")("N")("G")("1")(parameter_code+9);@/ -load13("B")("I")("G")("O")("P") - ("S")("P")("A")("C")("I")("N")("G")("2")(parameter_code+10);@/ -load13("B")("I")("G")("O")("P") - ("S")("P")("A")("C")("I")("N")("G")("3")(parameter_code+11);@/ -load13("B")("I")("G")("O")("P") - ("S")("P")("A")("C")("I")("N")("G")("4")(parameter_code+12);@/ -load13("B")("I")("G")("O")("P") - ("S")("P")("A")("C")("I")("N")("G")("5")(parameter_code+13);@/ - -@ When a left parenthesis has been scanned, the following routine -is used to interpret the keyword that follows, and to store the -equivalent value in |cur_code|. - -@p procedure get_name; -begin incr(loc); incr(level); {pass the left parenthesis} -cur_char:=" "; -while cur_char=" " do get_next; -if (cur_char>")")or(cur_char<"(") then decr(loc); {back up one character} -name_length:=0; get_keyword_char; {prepare to scan the name} -while cur_char<>" " do begin - if name_length=longest_name then cur_name[1]:="X" {force error} - else incr(name_length); - cur_name[name_length]:=cur_char; - get_keyword_char; - end; -lookup; -if name_ptr=0 then err_print('Sorry, I don''t know that property name'); -@.Sorry, I don't know...@> -cur_code:=equiv[name_ptr]; -end; - -@* Scanning numeric data. -The next thing we need is a trio of subroutines to read the one-byte, -four-byte, and real numbers that may appear as property values. -These subroutines are careful to stick to numbers between $-2^{31}$ -and $2^{31}-1$, inclusive, so that a computer with two's complement -32-bit arithmetic will not be interrupted by overflow. - -@ The first number scanner, which returns a one-byte value, surely has -no problems of arithmetic overflow. - -@p function get_byte:byte; {scans a one-byte property value} -var acc:integer; {an accumulator} -@!t:ASCII_code; {the type of value to be scanned} -begin repeat get_next; -until cur_char<>" "; {skip the blanks before the type code} -t:=cur_char; acc:=0; -repeat get_next; -until cur_char<>" "; {skip the blanks after the type code} -if t="C" then @<Scan an ASCII character code@> -else if t="D" then @<Scan a small decimal number@> -else if t="O" then @<Scan a small octal number@> -else if t="H" then @<Scan a small hexadecimal number@> -else if t="F" then @<Scan a face code@> -else skip_error('You need "C" or "D" or "O" or "H" or "F" here'); -@.You need "C" or "D" ...here@> -cur_char:=" "; get_byte:=acc; -end; - -@ The |get_next| routine converts lower case to upper case, but it leaves -the character in the buffer, so we can unconvert it. - -@<Scan an ASCII...@>= -if (cur_char>=@'41)and(cur_char<=@'176)and - ((cur_char<"(")or(cur_char>")")) then - acc:=xord[buffer[loc]] -else skip_error('"C" value must be standard ASCII and not a paren') -@:C value}\.{"C" value must be...@> - -@ @<Scan a small dec...@>= -begin while (cur_char>="0")and(cur_char<="9") do begin - acc:=acc*10+cur_char-"0"; - if acc>65535 then begin - skip_error('This value shouldn''t exceed 65535'); -@.This value shouldn't...@> - acc:=0; cur_char:=" "; - end - else get_next; - end; -backup; -end - -@ @<Scan a small oct...@>= -begin while (cur_char>="0")and(cur_char<="7") do - begin acc:=acc*8+cur_char-"0"; - if acc>65535 then begin - skip_error('This value shouldn''t exceed ''177777'); -@.This value shouldn't...@> - acc:=0; cur_char:=" "; - end - else get_next; - end; -backup; -end - -@ @<Scan a small hex...@>= -begin while ((cur_char>="0")and(cur_char<="9"))or - ((cur_char>="A")and(cur_char<="F")) do begin - if cur_char>="A" then cur_char:=cur_char+"0"+10-"A"; - acc:=acc*16+cur_char-"0"; - if acc>65535 then begin - skip_error('This value shouldn''t exceed "FFFF'); -@.This value shouldn't...@> - acc:=0; cur_char:=" "; - end - else get_next; - end; -backup; -end - -@ @<Scan a face...@>= -begin if cur_char="B" then acc:=2 -else if cur_char="L" then acc:=4 -else if cur_char<>"M" then acc:=18; -get_next; -if cur_char="I" then incr(acc) -else if cur_char<>"R" then acc:=18; -get_next; -if cur_char="C" then acc:=acc+6 -else if cur_char="E" then acc:=acc+12 -else if cur_char<>"R" then acc:=18; -if acc>=18 then begin - skip_error('Illegal face code, I changed it to MRR'); -@.Illegal face code...@> - acc:=0; - end; -end - -@ The routine that scans a four-byte value puts its output into |cur_bytes|, -which is a record containing (yes, you guessed it) four bytes. - -@<Types...@>= -@!four_bytes=record @!b0:byte;@+@!b1:byte;@+@!b2:byte;@+@!b3:byte;@+end; - -@ @d c0==cur_bytes.b0 -@d c1==cur_bytes.b1 -@d c2==cur_bytes.b2 -@d c3==cur_bytes.b3 - -@<Glob...@>= -@!cur_bytes:four_bytes; {a four-byte accumulator} -@!zero_bytes:four_bytes; {four bytes all zero} - -@ @<Set init...@>= -zero_bytes.b0:=0; zero_bytes.b1:=0; zero_bytes.b2:=0; zero_bytes.b3:=0; - -@ Since the |get_four_bytes| routine is used very infrequently, no attempt -has been made to make it fast; we only want it to work. -This is no longer the case, but we hope that it is not too slow. - -@p procedure get_four_bytes; {scans an unsigned constant and sets |four_bytes|} -var c:integer; {leading byte} -@!r:integer; {radix} -begin repeat get_next; -until cur_char<>" "; {skip the blanks before the type code} -r:=0; cur_bytes:=zero_bytes; {start with the accumulator zero} -if cur_char="H" then r:=16 -else if cur_char="O" then r:=8 -else if cur_char="D" then r:=10 -else skip_error('Decimal ("D"), octal ("O") or hex ("H") value is needed here'); -@.Decimal ("D"), octal ("O") or hex ("H")...@> -if r>0 then begin - repeat get_next; - until cur_char<>" "; {skip the blanks after the type code} - while ((cur_char>="0")and(cur_char<="9"))or@| - ((cur_char>="A")and(cur_char<="F")) do - @<Multiply by |r|, add |cur_char-"0"|, and |get_next|@>; - end; -end; - -function get_integer:integer; {scans an integer property value} -begin get_four_bytes; -get_integer:=(c0*@"1000000)+(c1*@"10000)+(c2*@"100)+c3; -end; - -@ @<Multiply by |r|...@>= -begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A"; -if cur_char>="0"+r then skip_error('Illegal digit') -@.Illegal digit@> -else begin - c:=c3*r+cur_char-"0"; c3:=c mod 256;@/ - c:=c2*r+c div 256; c2:=c mod 256;@/ - c:=c1*r+c div 256; c1:=c mod 256;@/ - c:=c0*r+c div 256; - if c<256 then c0:=c - else begin - cur_bytes:=zero_bytes; - if r=8 then - skip_error('Sorry, the maximum octal value is O 37777777777') -@.Sorry, the maximum...@> - else if r=10 then - skip_error('Sorry, the maximum decimal value is D 4294967295') - else skip_error('Sorry, the maximum hex value is H FFFFFFFF'); - end; - get_next; - end; -end - -@ The remaining scanning routine is the most interesting. It scans a real -constant and returns the nearest |fix_word| approximation to that constant. -A |fix_word| is a 32-bit integer that represents a real value that -has been multiplied by $2^{20}$. Since \.{PLtoTF} restricts the magnitude -of reals to 2048, the |fix_word| will have a magnitude less than $2^{31}$. - -@d unity==@'4000000 {$2^{20}$, the |fix_word| 1.0} - -@<Types...@>= -@!fix_word=integer; {a scaled real value with 20 bits of fraction} -@!unsigned_integer=integer; - -@ When a real value is desired, we might as well treat `\.D' and `\.R' -formats as if they were identical. - -@p function get_fix:fix_word; {scans a real property value} -var negative:boolean; {was there a minus sign?} -@!acc:integer; {an accumulator} -@!int_part:integer; {the integer part} -@!j:0..7; {the number of decimal places stored} -begin repeat get_next; -until cur_char<>" "; {skip the blanks before the type code} -negative:=false; acc:=0; {start with the accumulators zero} -if (cur_char<>"R")and(cur_char<>"D") then - skip_error('An "R" or "D" value is needed here') -@.An "R" or "D" ... needed here@> -else begin - @<Scan the blanks and/or signs after the type code@>; - while (cur_char>="0") and (cur_char<="9") do - @<Multiply by 10, add |cur_char-"0"|, and |get_next|@>; - int_part:=acc; acc:=0; - if cur_char="." then @<Scan the fraction part and put it in |acc|@>; - if (acc>=unity)and(int_part=2047) then - skip_error('Real constants must be less than 2048') -@.Real constants must be...@> - else acc:=int_part*unity+acc; - end; -if negative then get_fix:=-acc@+else get_fix:=acc; -end; - -@ @<Scan the blanks...@>= -repeat get_next; -if cur_char="-" then begin - cur_char:=" "; negative:=true; - end -else if cur_char="+" then cur_char:=" "; -until cur_char<>" " - -@ @<Multiply by 10...@>= -begin acc:=acc*10+cur_char-"0"; -if acc>=2048 then begin - skip_error('Real constants must be less than 2048'); -@.Real constants must be...@> - acc:=0; cur_char:=" "; - end -else get_next; -end - -@ To scan the fraction $.d_1d_2\ldots\,$, we keep track of up to seven -of the digits $d_j$. A correct result is obtained if we first compute -$f^\prime=\lfloor 2^{21}(d_1\ldots d_j)/10^j\rfloor$, after which -$f=\lfloor(f^\prime+1)/2\rfloor$. It is possible to have $f=1.0$. - -@<Glob...@>= -@!fraction_digits:array[1..7] of integer; {$2^{21}$ times $d_j$} - -@ @<Scan the frac...@>= -begin j:=0; get_next; -while (cur_char>="0")and(cur_char<="9") do begin - if j<7 then begin - incr(j); fraction_digits[j]:=@'10000000*(cur_char-"0"); - end; - get_next; - end; -acc:=0; -while j>0 do begin - acc:=fraction_digits[j]+(acc div 10); decr(j); - end; -acc:=(acc+10) div 20; -end - -@* Storing the property values. -When property values have been found, they are squirreled away in a bunch -of arrays. The header information is unpacked into bytes in an array -called |header_bytes|. The ligature/kerning program is stored in an array -of type |four_bytes|. -Another |four_bytes| array holds the specifications of extensible characters. -The kerns and parameters are stored in separate arrays of |fix_word| values. - -Instead of storing the design size in the header array, we will keep it -in a |fix_word| variable until the last minute. The number of units in the -design size is also kept in a |fix_word|. - -@<Glob...@>= -@!header_bytes:array[header_index] of byte; {the header block} -@!header_ptr:header_index; {the number of header bytes in use} -@!design_size:fix_word; {the design size} -@!design_units:fix_word; {reciprocal of the scaling factor} -@!seven_bit_safe_flag:boolean; {does the file claim to be seven-bit-safe?} -@!lig_kern:array[0..max_lig_steps] of four_bytes; {the ligature program} -@!nl:unsigned_integer; {the number of ligature/kern instructions so far} -@!min_nl:unsigned_integer; {the final value of |nl| must be at least this} -@!kern:array[0..max_kerns] of fix_word; {the distinct kerning amounts} -@!nk:0..max_kerns; {the number of entries of |kern|} -@!exten:array[char_type] of four_bytes; {extensible character specs} -@!ne:xchar_type; {the number of extensible characters} -@!param:array[1..max_param_words] of fix_word; {\.{FONTDIMEN} parameters} -@!np:0..max_param_words; {the largest parameter set nonzero} -@!check_sum_specified:boolean; {did the user name the check sum?} -@!bchar:xchar_type; {the right boundary character, or 256 if unspecified} -@!font_dir:integer; {font direction} - -@ @<Types...@>= -@!char_type=0..max_char; -@!xchar_type=0..xmax_char; -@!xxchar_type=0..xxmax_char; -@!xxxchar_type=0..xxxmax_char; -@!header_index=0..max_header_bytes; -@!indx=xxchar_type; - -@ @<Local...@>= -@!d:header_index; {an index into |header_bytes|} - -@ We start by setting up the default values. - -@d check_sum_loc=0 -@d design_size_loc=4 -@d coding_scheme_loc=8 -@d family_loc=coding_scheme_loc+40 -@d seven_flag_loc=family_loc+20 -@d face_loc=seven_flag_loc+3 - -@<Set init...@>= -for d:=0 to 18*4-1 do header_bytes[d]:=0; -header_bytes[8]:=11; header_bytes[9]:="U"; -header_bytes[10]:="N"; -header_bytes[11]:="S"; -header_bytes[12]:="P"; -header_bytes[13]:="E"; -header_bytes[14]:="C"; -header_bytes[15]:="I"; -header_bytes[16]:="F"; -header_bytes[17]:="I"; -header_bytes[18]:="E"; -header_bytes[19]:="D"; -@.UNSPECIFIED@> -for d:=family_loc to family_loc+11 do header_bytes[d]:=header_bytes[d-40]; -design_size:=10*unity; design_units:=unity; seven_bit_safe_flag:=false;@/ -header_ptr:=18*4; nl:=0; min_nl:=0; nk:=0; ne:=0; np:=0;@/ -check_sum_specified:=false; bchar:=xmax_char; -font_dir:=0; - -@ Most of the dimensions, however, go into the |memory| array. There are -at most |max_char+2| widths, |max_char+2| heights, |max_char+2| depths, -and |max_char+2| italic corrections, since the value 0 is required but -it need not be used. So |memory| has room for |4*max_char+8| entries, -each of which is a |fix_word|. An auxiliary table called |link| is -used to link these words together in linear lists, so that sorting and -other operations can be done conveniently. - -We also add four ``list head'' words to the |memory| and |link| arrays; -these are in locations |width| through |italic|, i.e., 1 through 4. -For example, |link[height]| points to the smallest element in -the sorted list of distinct heights that have appeared so far, and -|memory[height]| is the number of distinct heights. - -@<Types...@>= -@!pointer=0..mem_size; {an index into memory} - -@ The arrays |char_wd|, |char_ht|, |char_dp|, and |char_ic| contain -pointers to the |memory| array entries where the corresponding dimensions -appear. Two other arrays, |char_tag| and |char_remainder|, hold -the other information that \.{TFM} files pack into a |char_info_word|. - -@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} -@d bchar_label==char_remainder[xmax_char] - {beginning of ligature program for left boundary} - -@<Glob...@>= -@!memory:array[pointer] of fix_word; {character dimensions and kerns} -@!mem_ptr:pointer; {largest |memory| word in use} -@!link:array[pointer] of pointer; {to make lists of |memory| items} -@!char_wd:array[char_type] of pointer; {pointers to the widths} -@!char_ht:array[char_type] of pointer; {pointers to the heights} -@!char_dp:array[char_type] of pointer; {pointers to the depths} -@!char_ic:array[char_type] of pointer; {pointers to italic corrections} -@!char_tag:array[char_type] of no_tag..ext_tag; {character tags} -@!char_remainder:array[xchar_type] of xchar_type; - {pointers to ligature labels, - next larger characters, or extensible characters} -@!top_width,@!top_height,@!top_depth,@!top_italic:integer; - -@ @<Local...@>= -@!c:integer; {runs through all character codes} - -@ @<Set init...@>= -bchar_label:=xmax_label; -for c:=0 to max_char do begin - char_wd[c]:=0; char_ht[c]:=0; char_dp[c]:=0; char_ic[c]:=0;@/ - char_tag[c]:=no_tag; char_remainder[c]:=0; - end; -memory[0]:=@'17777777777; {an ``infinite'' element at the end of the lists} -memory[width]:=0; link[width]:=0; {width list is empty} -memory[height]:=0; link[height]:=0; {height list is empty} -memory[depth]:=0; link[depth]:=0; {depth list is empty} -memory[italic]:=0; link[italic]:=0; {italic list is empty} -mem_ptr:=italic; - -@ As an example of these data structures, let us consider the simple -routine that inserts a potentially new element into one of the dimension -lists. The first parameter indicates the list head (i.e., |h=width| for -the width list, etc.); the second parameter is the value that is to be -inserted into the list if it is not already present. The procedure -returns the value of the location where the dimension appears in |memory|. -The fact that |memory[0]| is larger than any legal dimension makes the -algorithm particularly short. - -We do have to handle two somewhat subtle situations. A width of zero must be -put into the list, so that a zero-width character in the font will not appear -to be nonexistent (i.e., so that its |char_wd| index will not be zero), but -this does not need to be done for heights, depths, or italic corrections. -Furthermore, it is necessary to test for memory overflow even though we -have provided room for the maximum number of different dimensions in any -legal font, since the \.{PL} file might foolishly give any number of -different sizes to the same character. - -@p function sort_in(@!h:pointer;@!d:fix_word):pointer; {inserts into list} -var p:pointer; {the current node of interest} -begin if (d=0)and(h<>width) then sort_in:=0 -else begin - p:=h; - while d>=memory[link[p]] do p:=link[p]; - if (d=memory[p])and(p<>h) then sort_in:=p - else if mem_ptr=mem_size then - begin err_print('Memory overflow: too many widths, etc'); -@.Memory overflow...@> - print_ln('Congratulations! It''s hard to make this error.'); - sort_in:=p; - end - else begin - incr(mem_ptr); memory[mem_ptr]:=d; - link[mem_ptr]:=link[p]; link[p]:=mem_ptr; incr(memory[h]); - sort_in:=mem_ptr; - end; - end; -end; - -@ When these lists of dimensions are eventually written to the \.{OFM} -file, we may have to do some rounding of values, because the \.{OFM} file -allows at most 65536 widths, 256 heights, 256 depths, and 256 italic -corrections. The following procedure takes a given list head |h| and a -given dimension |d|, and returns the minimum $m$ such that the elements -of the list can be covered by $m$ intervals of width $d$. It also sets -|next_d| to the smallest value $d^\prime>d$ such that the covering found -by this procedure would be different. In particular, if $d=0$ it computes -the number of elements of the list, and sets |next_d| to the smallest -distance between two list elements. (The covering by intervals of width -|next_d| is not guaranteed to have fewer than $m$ elements, but in -practice this seems to happen most of the time.) - -@<Glob...@>= -@!next_d:fix_word; {the next larger interval that is worth trying} - -@ Once again we can make good use of the fact that |memory[0]| is ``infinite.'' - -@p function min_cover(@!h:pointer;@!d:fix_word):integer; -var p:pointer; {the current node of interest} -@!l:fix_word; {the least element covered by the current interval} -@!m:integer; {the current size of the cover being generated} -begin m:=0; p:=link[h]; next_d:=memory[0]; -while p<>0 do begin - incr(m); l:=memory[p]; - while memory[link[p]]<=l+d do p:=link[p]; - p:=link[p]; - if memory[p]-l<next_d then next_d:=memory[p]-l; - end; -min_cover:=m; -end; - -@ The following procedure uses |min_cover| to determine the smallest $d$ -such that a given list can be covered with at most a given number of -intervals. - -@p function shorten(@!h:pointer;m:integer):fix_word; {finds best way to round} -var d:fix_word; {the current trial interval length} -@!k:integer; {the size of a minimum cover} -begin if memory[h]>m then begin - excess:=memory[h]-m; - k:=min_cover(h,0); d:=next_d; {now the answer is at least |d|} - repeat d:=d+d; k:=min_cover(h,d); - until k<=m; {first we ascend rapidly until finding the range} - d:=d div 2; k:=min_cover(h,d); {now we run through the feasible steps} - while k>m do begin - d:=next_d; k:=min_cover(h,d); - end; - shorten:=d; - end -else shorten:=0; -end; - -@ When we are nearly ready to output the \.{TFM} file, we will set -|index[p]:=k| if the dimension in |memory[p]| is being rounded to the -|k|th element of its list. - -@<Glob...@>= -@!index:array[pointer] of byte; -@!excess:byte; {number of words to remove, if list is being shortened} - -@ Here is the procedure that sets the |index| values. It also shortens -the list so that there is only one element per covering interval; -the remaining elements are the midpoints of their clusters. - -@p procedure set_indices(@!h:pointer;@!d:fix_word); - {reduces and indexes a list} -var p:pointer; {the current node of interest} -@!q:pointer; {trails one step behind |p|} -@!m:byte; {index number of nodes in the current interval} -@!l:fix_word; {least value in the current interval} -begin q:=h; p:=link[q]; m:=0; -while p<>0 do begin - incr(m); l:=memory[p]; index[p]:=m; - while memory[link[p]]<=l+d do begin - p:=link[p]; index[p]:=m; decr(excess); - if excess=0 then d:=0; - end; - link[q]:=p; memory[p]:=l+(memory[p]-l) div 2; q:=p; p:=link[p]; - end; -memory[h]:=m; -end; - -@* The input phase. -We're ready now to read and parse the \.{PL} file, storing property -values as we go. - -@<Glob...@>= -@!c:integer; {the current character or byte being processed} -@!cprime:char_type; {Processing for several characters together} -@!crange:char_type; {ditto} - -@ @<Read all the input@>= -cur_char:=" "; -repeat while cur_char=" " do get_next; -if cur_char="(" then @<Read a font property value@> -else if (cur_char=")")and not input_has_ended then begin - err_print('Extra right parenthesis'); - incr(loc); cur_char:=" "; - end -@.Extra right parenthesis@> -else if not input_has_ended then junk_error; -until input_has_ended - -@ The |junk_error| routine just referred to is called when something -appears in the forbidden area between properties of a property list. - -@p procedure junk_error; {gets past no man's land} -begin err_print('There''s junk here that is not in parentheses'); -@.There's junk here...@> -skip_to_paren; -end; - -@ For each font property, we are supposed to read the data from the -left parenthesis that is the current value of |cur_char| to the right -parenthesis that matches it in the input. The main complication is -to recover with reasonable grace from various error conditions that -might arise. - -@<Read a font property value@>= -begin get_name; -if cur_code=comment_code then skip_to_end_of_item -else if (cur_code<110) and (cur_code>character_code) then - flush_error('This property name doesn''t belong on the outer level') -else if (cur_code>=110) and ((cur_code mod 10)<>0) then - flush_error('This property name doesn''t belong on the outer level') -@.This property name doesn't belong...@> -else begin @<Read the font property value specified by |cur_code|@>; - finish_the_property; - end; -end - -@ @<Read the font property value spec...@>= -case cur_code of - check_sum_code: begin - check_sum_specified:=true; - read_four_bytes(check_sum_loc); - end; - design_size_code: @<Read the design size@>; - design_units_code: @<Read the design units@>; - coding_scheme_code: read_BCPL(coding_scheme_loc,40); - family_code: read_BCPL(family_loc,20); - face_code: begin - c:=get_byte; if c>255 then - begin err_print('FACE clipped to 255'); c:=255 end; - header_bytes[face_loc]:=c - end; - seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>; - header_code: @<Read an indexed header word@>; - font_dimen_code: @<Read font parameter list@>; - lig_table_code: read_lig_kern; - boundary_char_code: bchar:=get_byte; - character_code: read_char_info; - ofm_level_code: @<Read OFM level code@>; - font_dir_code: @<Read font direction code@>; - n_font_dir_code: @<Read natural font direction code@>; - char_repeat_code: read_repeated_character_info; - font_rule_code: read_font_rule_list; - font_glue_code: read_font_glue_list; - font_penalty_code: read_font_penalty_list; - font_mvalue_code: read_font_mvalue_list; - font_fvalue_code: read_font_fvalue_list; - font_ivalue_code: read_font_ivalue_list; - end - -@ The |case| statement just given makes use of two subroutines that we -haven't defined yet. The first of these puts a 32-bit octal quantity -into four specified bytes of the header block. - -@p procedure read_four_bytes(l:header_index); -begin get_four_bytes; -header_bytes[l]:=c0; -header_bytes[l+1]:=c1; -header_bytes[l+2]:=c2; -header_bytes[l+3]:=c3; -end; - -@ The second little procedure is used to scan a string and to store it in -the ``{\mc BCPL} format'' required by \.{TFM} files. The string is supposed -to contain at most |n| bytes, including the first byte (which holds the -length of the rest of the string). - -@p procedure read_BCPL(l:header_index;n:byte); -var k:header_index; -begin k:=l; -while cur_char=" " do get_next; -while (cur_char<>"(")and(cur_char<>")") do begin - if k<l+n then incr(k); - if k<l+n then header_bytes[k]:=cur_char; - get_next; - end; -if k=l+n then begin - err_print('String is too long; its first ',n-1:1, -@.String is too long...@> - ' characters will be kept'); decr(k); - end; -header_bytes[l]:=k-l; -while k<l+n-1 do begin {tidy up the remaining bytes by setting them to nulls} - incr(k); header_bytes[k]:=0; - end; -end; - -@ @<Read the design size@>= -begin next_d:=get_fix; -if next_d<unity then - err_print('The design size must be at least 1') -@.The design size must...@> -else design_size:=next_d; -end - -@ @<Read the design units@>= -begin next_d:=get_fix; -if next_d<=0 then - err_print('The number of units per design size must be positive') -@.The number of units...@> -else design_units:=next_d; -end - -@ @<Read the seven-bit-safe...@>= -begin while cur_char=" " do get_next; -if cur_char="T" then seven_bit_safe_flag:=true -else if cur_char="F" then seven_bit_safe_flag:=false -else err_print('The flag value should be "TRUE" or "FALSE"'); -@.The flag value should be...@> -skip_to_paren; -end - -@ @<Read an indexed header word@>= -begin c:=get_byte; -if c<18 then skip_error('HEADER indices should be 18 or more') -@.HEADER indices...@> -else if 4*c+4>max_header_bytes then - skip_error('This HEADER index is too big for my present table size') -@.This HEADER index is too big...@> -else begin - while header_ptr<4*c+4 do begin - header_bytes[header_ptr]:=0; incr(header_ptr); - end; - read_four_bytes(4*c); - end; -end - -@ The remaining kinds of font property values that need to be read are -those that involve property lists on higher levels. Each of these has a -loop similar to the one that was used at level zero. Then we put the -right parenthesis back so that `|finish_the_property|' will be happy; -there is probably a more elegant way to do this. - -@d finish_inner_property_list==begin decr(loc); incr(level); cur_char:=")"; - end - -@<Read font parameter list@>= -begin while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a parameter value@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a parameter value@>= -begin get_name; -if cur_code=comment_code then skip_to_end_of_item -else if (cur_code<parameter_code)or(cur_code>=char_wd_code) then - flush_error('This property name doesn''t belong in a FONTDIMEN list') -@.This property name doesn't belong...@> -else begin - if cur_code=parameter_code then c:=get_integer - else c:=cur_code-parameter_code; - if c=0 then flush_error('PARAMETER index must not be zero') -@.PARAMETER index must not...@> - else if c>max_param_words then - flush_error('This PARAMETER index is too big for my present table size') -@.This PARAMETER index is too big...@> - else begin - while np<c do begin - incr(np); param[np]:=0; - end; - param[c]:=get_fix; - finish_the_property; - end; - end; -end - -@ @<Read ligature/kern list@>= -begin lk_step_ended:=false; -while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then read_lig_kern_command - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a ligature/kern command@>= -begin get_name; -if cur_code=comment_code then skip_to_end_of_item -else if (cur_code>=label_code) and (cur_code<=(lig_code+11)) then begin - case cur_code of - label_code:@<Read a label step@>; - stop_code:@<Read a stop step@>; - skip_code:@<Read a skip step@>; - krn_code:@<Read a kerning step@>; - lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5, - lig_code+6,lig_code+7,lig_code+11:@<Read a ligature step@>; - end; {there are no other cases |>=label_code|} - finish_the_property; -end -else if (cur_code>=clabel_code) and (cur_code<=cpenglue_code) then begin - case cur_code of - clabel_code:@<Read an extended label step@>; - cpen_code:@<Read an extended penalty step@>; - cglue_code:@<Read an extended glue step@>; - cpenglue_code:@<Read an extended penalty/glue step@>; - ckrn_code:@<Read an extended kern step@>; - end; {there are no other cases |>=label_code|} - finish_the_property; -end -else flush_error('This property name doesn''t belong in a LIGTABLE list'); -@.This property name doesn't belong...@> -end - -@ When a character is about to be tagged, we call the following -procedure so that an error message is given in case of multiple tags. - -@p procedure check_tag(c:integer); {print error if |c| already tagged} -begin case char_tag[c] of - no_tag: do_nothing; - lig_tag: err_print('This character already appeared in a LIGTABLE LABEL'); -@.This character already...@> - list_tag: err_print('This character already has a NEXTLARGER spec'); - ext_tag: err_print('This character already has a VARCHAR spec'); - end; -end; - -@ @<Read a label step@>= -begin while cur_char=" " do get_next; -if cur_char="B" then begin - bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}} - end -else begin - backup; c:=get_byte; - check_tag(c); char_tag[c]:=lig_tag; char_remainder[c]:=nl; - end; -if min_nl<=nl then min_nl:=nl+1; -lk_step_ended:=false; -end - -@ @d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program} -@d kern_flag=128 {op code for a kern step} - -@<Globals...@>= -@!lk_step_ended:boolean; - {was the last \.{LIGTABLE} property \.{LIG} or \.{KRN}?} -@!krn_ptr:0..max_kerns; {an index into |kern|} - -@ @<Read a stop step@>= -if not lk_step_ended then - err_print('STOP must follow LIG or KRN') -@.STOP must follow LIG or KRN@> -else begin - lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag; - lk_step_ended:=false; - end - -@ @<Read a skip step@>= -if not lk_step_ended then - err_print('SKIP must follow LIG or KRN') -@.SKIP must follow LIG or KRN@> -else begin - c:=get_byte; - if c>=128 then err_print('Maximum SKIP amount is 127') -@.Maximum SKIP amount...@> - else if nl+c>=max_lig_steps then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> - else begin - lig_kern[nl-1].b0:=c; - if min_nl<=nl+c then min_nl:=nl+c+1; - end; - lk_step_ended:=false; - end - -@ @<Read a ligature step@>= -begin lig_kern[nl].b0:=0; -lig_kern[nl].b2:=cur_code-lig_code; -lig_kern[nl].b1:=get_byte; -lig_kern[nl].b3:=get_byte; -if nl>=max_lig_steps-1 then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> -else incr(nl); -lk_step_ended:=true; -end - -@ @<Read a kerning step@>= -begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte; -kern[nk]:=get_fix; krn_ptr:=0; -while kern[krn_ptr]<>kern[nk] do incr(krn_ptr); -if krn_ptr=nk then begin - if nk<max_kerns then incr(nk) - else begin - err_print('Sorry, too many different kerns for me to handle'); -@.Sorry, too many different kerns...@> - decr(krn_ptr); - end; - end; -if ofm_level=-1 then begin - lig_kern[nl].b2:=kern_flag+(krn_ptr div 256); - lig_kern[nl].b3:=krn_ptr mod 256; - end -else begin - lig_kern[nl].b2:=kern_flag+(krn_ptr div 65536); - lig_kern[nl].b3:=krn_ptr mod 65536; - end; -if nl>=max_lig_steps-1 then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> -else incr(nl); -lk_step_ended:=true; -end - -@ @<Global...@>= -@!category_remainders:array[0..256] of integer; -@!ivalue_category,@!max_ivalue_category:integer; -@!glue_category,@!max_glue_category:integer; -@!penalty_category,@!max_penalty_category:integer; - -@ @<Set init...@>= -for ivalue_category:=0 to 256 do begin - category_remainders[ivalue_category]:=-1; - end; -max_ivalue_category:=-1; -max_glue_category:=-1; -max_penalty_category:=-1; - -@ @<Read an extended label step@>= -begin -c:=get_byte; -category_remainders[c]:=nl; -if max_ivalue_category<c then max_ivalue_category:=c; -if min_nl<=nl then min_nl:=nl+1; -lk_step_ended:=false; -end - -@ @<Read an extended penalty step@>= -begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte; -lig_kern[nl].b2:=17; -penalty_category:=get_byte; -if max_penalty_category<penalty_category then - max_penalty_category:=penalty_category; -lig_kern[nl].b3:=penalty_category; -if nl>=max_lig_steps-1 then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> -else incr(nl); -lk_step_ended:=true; -end - -@ @<Read an extended glue step@>= -begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte; -lig_kern[nl].b2:=18; -glue_category:=get_byte; -if max_glue_category<glue_category then - max_glue_category:=glue_category; -lig_kern[nl].b3:=glue_category; -if nl>=max_lig_steps-1 then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> -else incr(nl); -lk_step_ended:=true; -end - -@ @<Read an extended penalty/glue step@>= -begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte; -lig_kern[nl].b2:=19; -penalty_category:=get_byte; -if max_penalty_category<penalty_category then - max_penalty_category:=penalty_category; -glue_category:=get_byte; -if max_glue_category<glue_category then - max_glue_category:=glue_category; -lig_kern[nl].b3:=penalty_category*256+glue_category; -if nl>=max_lig_steps-1 then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> -else incr(nl); -lk_step_ended:=true; -end - -@ @<Read an extended kern step@>= -begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte; -lig_kern[nl].b2:=20; -kern[nk]:=get_fix; krn_ptr:=0; -while kern[krn_ptr]<>kern[nk] do incr(krn_ptr); -if krn_ptr=nk then begin - if nk<max_kerns then incr(nk) - else begin - err_print('Sorry, too many different kerns for me to handle'); -@.Sorry, too many different kerns...@> - decr(krn_ptr); - end; - end; -if krn_ptr>65535 then - err_print('Sorry, too many different kerns for me to handle'); -lig_kern[nl].b3:=krn_ptr; -if nl>=max_lig_steps-1 then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> -else incr(nl); -lk_step_ended:=true; -end - -@ @<Globals...@>= -@!char_extended_tag:array [char_type] of boolean; - -@ @<Set init...@>= -for c:=0 to max_char do - char_extended_tag[c]:=false; - -@ @<Finish up the extended font stuff@>= -begin -if max_penalty_category>0 then begin - if nkp=0 then - err_print('No PENALTY table') - else if npp[0]<max_penalty_category then - err_print('Not enough PENALTY entries'); - end; -if max_glue_category>0 then begin - if nkg=0 then - err_print('No GLUE table') - else if npg[0]<max_glue_category then - err_print('Not enough GLUE entries'); - end; -if max_ivalue_category>0 then begin - if nki=0 then - err_print('No IVALUE table') - else if npi[0]<max_ivalue_category then - err_print('Not enough IVALUE entries') - else begin - for c:=0 to max_char do begin - if (char_wd[c]<>0) then begin - for j:=0 to max_ivalue_category do - if char_table[c,0]=j then begin - if category_remainders[j]<>-1 then begin - if char_tag[c]<>0 then - err_print('Character already has a tag') - else begin - char_extended_tag[c]:=true; - char_remainder[c]:=category_remainders[j]; - end; - end; - end; - end; - end; - end; - end; -end - -@ @<Global...@>= -tables_read:boolean; - -@ @<Set init...@>= -tables_read:=false; - -@ Finally we come to the part of \.{PLtoTF}'s input mechanism -that is used most, the processing of individual character data. - -@<Read character info list@>= -begin -if not tables_read then begin - compute_new_header_ofm; - tables_read:=true; - end; -c:=get_byte; {read the character code that is being specified} -@<Print |c| in hex notation@>; -while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then read_character_property - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|} -finish_inner_property_list; -end - -@ @<Globals...@>= -@!char_original:array [0..max_char] of integer; -@!char_repeats:array [0..max_char] of integer; -@!diff:boolean; -@!needed_space,@!extra_bytes:integer; - -@ @<Set init...@>= -for ch_entry:=0 to max_char do begin - char_original[ch_entry]:=ch_entry; - char_repeats[ch_entry]:=0; - end; - -@ @<Read repeated character info@>= -begin -if not tables_read then begin - @<Compute the new header information for OFM files@>; - tables_read:=true; - end; -c:=get_byte; {read the character code that is being specified} -@<Print |c| in hex notation@>; -crange:=get_byte; {read how many characters are being defined} -if (crange<0) then begin - err_print('Character ranges must be positive'); - crange:=0; - end; -if ((c+crange)>max_char) then begin - err_print('Character range too large'); - crange:=0; - end; -print('-'); print_hex(c+crange); -while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then read_character_property - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|} -finish_inner_property_list; -cprime:=c; -for c:=(cprime+1) to (cprime+crange) do begin - char_wd[c]:=char_wd[cprime]; - char_ht[c]:=char_ht[cprime]; - char_dp[c]:=char_dp[cprime]; - char_ic[c]:=char_ic[cprime]; - for tab:=0 to (nki+nkf+nkr+nkg+nkp-1) do begin - char_table[c,tab]:= char_table[cprime,tab]; - end; - end; -end - -@ Tables for character parameters - -@d char_param_tables==8 - -@<Globals...@>= -@!char_table:array [0..max_char,0..char_param_tables] of integer; -@!ch_table,@!ch_entry:integer; -@!temp_value:integer; - -@ @<Set init...@>= -for c:=0 to max_char do - for ch_table:=0 to char_param_tables do - char_table[c,ch_table]:=0; - -@ @<Read a character property@>= -begin get_name; -if cur_code=comment_code then skip_to_end_of_item -else if (cur_code<char_wd_code)or - ((cur_code>var_char_code)and - ((cur_code<char_ivalue_code)or(cur_code>char_penalty_code))) -then - flush_error('This property name doesn''t belong in a CHARACTER list') -@.This property name doesn't belong...@> -else begin - case cur_code of - char_wd_code:char_wd[c]:=sort_in(width,get_fix); - char_ht_code:char_ht[c]:=sort_in(height,get_fix); - char_dp_code:char_dp[c]:=sort_in(depth,get_fix); - char_ic_code:char_ic[c]:=sort_in(italic,get_fix); - sec_width_code:temp_value:=get_fix; - sec_height_code:temp_value:=get_fix; - sec_depth_code:temp_value:=get_fix; - sec_italic_code:temp_value:=get_fix; - accent_code:temp_value:=get_fix; - prim_top_axis_code:temp_value:=get_fix; - prim_top_axis_bis_code:temp_value:=get_fix; - prim_bot_axis_code:temp_value:=get_fix; - prim_bot_axis_bis_code:temp_value:=get_fix; - prim_mid_hor_code:temp_value:=get_fix; - prim_mid_vert_code:temp_value:=get_fix; - prim_base_slant_code:temp_value:=get_fix; - sec_top_axis_code:temp_value:=get_fix; - sec_top_axis_bis_code:temp_value:=get_fix; - sec_bot_axis_code:temp_value:=get_fix; - sec_bot_axis_bis_code:temp_value:=get_fix; - sec_mid_hor_code:temp_value:=get_fix; - sec_mid_vert_code:temp_value:=get_fix; - sec_base_slant_code:temp_value:=get_fix; - next_larger_code:begin check_tag(c); char_tag[c]:=list_tag; - char_remainder[c]:=get_byte; - end; - var_char_code:@<Read an extensible recipe for |c|@>; - char_ivalue_code: begin - ch_table:=get_integer; - ch_entry:=get_integer; - char_table[c,ch_table]:=ch_entry; - if ch_table>nkci then nkci:=ch_table; - end; - char_fvalue_code: begin - ch_table:=get_integer+nki; - ch_entry:=get_integer; - char_table[c,ch_table]:=ch_entry; - if ch_table>nkcf then nkcf:=ch_table; - end; - char_mvalue_code: begin - ch_table:=get_integer+nki+nkf; - ch_entry:=get_integer; - char_table[c,ch_table]:=ch_entry; - if ch_table>nkcm then nkcm:=ch_table; - end; - char_rule_code: begin - ch_table:=get_integer+nki+nkf+nkm; - ch_entry:=get_integer; - char_table[c,ch_table]:=ch_entry; - if ch_table>nkcr then nkcr:=ch_table; - end; - char_glue_code: begin - ch_table:=get_integer+nki+nkf+nkm+nkr; - ch_entry:=get_integer; - char_table[c,ch_table]:=ch_entry; - if ch_table>nkcg then nkcg:=ch_table; - end; - char_penalty_code: begin - ch_table:=get_integer+nki+nkf+nkm+nkr+nkg; - ch_entry:=get_integer; - char_table[c,ch_table]:=ch_entry; - if ch_table>nkcp then nkcp:=ch_table; - end; - end;@/ - finish_the_property; - end; -end - -@ @<Read an extensible r...@>= -begin if ne=xmax_char then - err_print('Sorry, too many VARCHAR specs') -@.Sorry, too many VARCHAR specs@> -else begin - check_tag(c); char_tag[c]:=ext_tag; char_remainder[c]:=ne;@/ - exten[ne]:=zero_bytes; - while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read an extensible piece@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; - incr(ne); - finish_inner_property_list; - end; -end - -@ @<Read an extensible p...@>= -begin get_name; -if cur_code=comment_code then skip_to_end_of_item -else if (cur_code<var_char_code+1)or(cur_code>var_char_code+4) then - flush_error('This property name doesn''t belong in a VARCHAR list') -@.This property name doesn't belong...@> -else begin - case cur_code-(var_char_code+1) of - 0:exten[ne].b0:=get_byte; - 1:exten[ne].b1:=get_byte; - 2:exten[ne].b2:=get_byte; - 3:exten[ne].b3:=get_byte; - end;@/ - finish_the_property; - end; -end - -@ The input routine is now complete except for the following code, -which prints a progress report as the file is being read. -@<Glob...@>= -@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char; - {strings for output in the user's external character set} -@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char; - {handy string constants for |face| codes} - -@ @<Set init...@>= -ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ -ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ -ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';@/ -HEX:='0123456789ABCDEF';@/ -MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE'; - -@ The array |dig| will hold a sequence of digits to be output. - -@<Glob...@>= -@!dig:array[0..32] of integer; - -@ Here, in fact, are two procedures that output -|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$. - -@p procedure out_digs(j:integer); {outputs |j| digits} -begin repeat decr(j); out(HEX[1+dig[j]]); -until j=0; -end; -@# -procedure print_digs(j:integer); {prints |j| digits} -begin repeat decr(j); print(HEX[1+dig[j]]); -until j=0; -end; - - -@ The |print_number| procedure indicates how |print_digs| can be used. -This procedure can print in octal, decimal or hex notation. - -@d print_hex(#)==print_number(#,16) -@d print_octal(#)==print_number(#,8) -@d print_decimal(#)==print_number(#,10) - -@p procedure print_number(c:integer; form:integer); {prints value of |c|} -var j:0..32; {index into |dig|} -begin -j:=0; -if (c<0) then begin - print_ln('Internal error: print_number (negative value)'); - c:=0 - end; -if form=8 then - print('''') {an apostrophe indicates the octal notation} -else if form=16 then - print('"') { a double apostrophe indicates the hexadecimal notation} -else if form<>10 then begin - print_ln('Internal error: print_number'); - form:=10 - end; -while (c>0) or (j=0) do begin - dig[j]:=c mod form; c:=c div form; - j:=j+1; - end; -print_digs(j); -end; - - -@ @<Print |c| in hex...@>= -begin if chars_on_line=8 then begin - print_ln(' '); chars_on_line:=1; - end -else begin - if chars_on_line>0 then print(' '); - incr(chars_on_line); - end; -print_hex(c); {progress report} -end - -@* The checking and massaging phase. -Once the whole \.{PL} file has been read in, we must check it for consistency -and correct any errors. This process consists mainly of running through -the characters that exist and seeing if they refer to characters that -don't exist. We also compute the true value of |seven_unsafe|; we make sure -that the charlists and ligature programs contain no loops; and we -shorten the lists of widths, heights, depths, and italic corrections, -if necessary, to keep from exceeding the required maximum sizes. - -@<Glob...@>= -@!seven_unsafe:boolean; {do seven-bit characters generate eight-bit ones?} - -@ @<Correct and check the information@>= -if nl>0 then @<Make sure the ligature/kerning program ends appropriately@>; -seven_unsafe:=false; -for c:=0 to max_char do if char_wd[c]<>0 then - @<For all characters |g| generated by |c|, - make sure that |char_wd[g]| is nonzero, and - set |seven_unsafe| if |c<128<=g|@>; -if bchar_label<xmax_label then begin - c:=xmax_char; @<Check ligature program of |c|@>; - end; -if seven_bit_safe_flag and seven_unsafe then - print_ln('The font is not really seven-bit-safe!'); -@.The font is not...safe@> -@<Check for infinite ligature loops@>; -@<Doublecheck the lig/kern commands and the extensible recipes@>; -finish_extended_font; -for c:=0 to max_char do - @<Make sure that |c| is not the largest element of a charlist cycle@>; -@<Put the width, height, depth, and italic lists into final form@> - -@ The checking that we need in several places is accomplished by three -macros that are only slightly tricky. - -@d existence_tail(#)==begin char_wd[g]:=sort_in(width,0); - print(#,' '); print_hex(c); - print_ln(' had no CHARACTER spec.'); - end; - end -@d check_existence_and_safety(#)==begin g:=#; - if (g>=128)and(c<128) then seven_unsafe:=true; - if char_wd[g]=0 then existence_tail -@d check_existence(#)==begin g:=#; - if char_wd[g]=0 then existence_tail - -@<For all characters |g| generated by |c|...@>= -case char_tag[c] of - no_tag: do_nothing; - lig_tag: @<Check ligature program of |c|@>; - list_tag: check_existence_and_safety(char_remainder[c]) - ('The character NEXTLARGER than'); -@.The character NEXTLARGER...@> - ext_tag:@<Check the pieces of |exten[c]|@>; - end - -@ @<Check the pieces...@>= -begin if exten[char_remainder[c]].b0>0 then - check_existence_and_safety(exten[char_remainder[c]].b0) - ('TOP piece of character'); -@.TOP piece of character...@> -if exten[char_remainder[c]].b1>0 then - check_existence_and_safety(exten[char_remainder[c]].b1) - ('MID piece of character'); -@.MID piece of character...@> -if exten[char_remainder[c]].b2>0 then - check_existence_and_safety(exten[char_remainder[c]].b2) - ('BOT piece of character'); -@.BOT piece of character...@> -check_existence_and_safety(exten[char_remainder[c]].b3) - ('REP piece of character'); -@.REP piece of character...@> -end - -@ @<Make sure that |c| is not the largest element of a charlist cycle@>= -if char_tag[c]=list_tag then begin - g:=char_remainder[c]; - while (g<c)and(char_tag[g]=list_tag) do g:=char_remainder[g]; - if g=c then begin - char_tag[c]:=no_tag; - print('A cycle of NEXTLARGER characters has been broken at '); -@.A cycle of NEXTLARGER...@> - print_hex(c); print_ln('.'); - end; - end - -@ @<Global...@>= -@!delta:fix_word; {size of the intervals needed for rounding} - -@ @d round_message(#)==if delta>0 then print_ln('I had to round some ', -@.I had to round...@> - #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.') - -@<Put the width, height, depth, and italic lists into final form@>= -case ofm_level of - -1: begin - top_width:=255; top_depth:=15; top_height:=15; top_italic:=63; - end; - 0: begin - top_width:=65535; top_depth:=255; top_height:=255; top_italic:=255; - end; - 1: begin - top_width:=65535; top_depth:=255; top_height:=255; top_italic:=255; - end; - end; -delta:=shorten(width,top_width); set_indices(width,delta); - round_message('width');@/ -delta:=shorten(height,top_height); set_indices(height,delta); - round_message('height');@/ -delta:=shorten(depth,top_depth); set_indices(depth,delta); - round_message('depth');@/ -delta:=shorten(italic,top_italic); set_indices(italic,delta); - round_message('italic correction'); - -@ @d clear_lig_kern_entry== {make an unconditional \.{STOP}} - lig_kern[nl].b0:=255; lig_kern[nl].b1:=0; - lig_kern[nl].b2:=0; lig_kern[nl].b3:=0 - -@<Make sure the ligature/kerning program ends...@>= -begin if bchar_label<xmax_label then {make room for it} begin - clear_lig_kern_entry; incr(nl); - end; {|bchar_label| will be stored later} -while min_nl>nl do begin - clear_lig_kern_entry; incr(nl); - end; -if (lig_kern[nl-1].b0 mod 256)=0 then - lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag; -end - -@ It's not trivial to check for infinite loops generated by repeated -insertion of ligature characters. But fortunately there is a nice -algorithm for such testing, copied here from the program \.{TFtoPL} -where it is explained further. - -@d simple=0 {$f(x,y)=z$} -@d left_z=1 {$f(x,y)=f(z,y)$} -@d right_z=2 {$f(x,y)=f(x,z)$} -@d both_z=3 {$f(x,y)=f(f(x,z),y)$} -@d pending=4 {$f(x,y)$ is being evaluated} - - -@ @<Glo...@>= -@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|} -@!hash:array[0..hash_size] of integer; -@!class:array[0..hash_size] of simple..pending; -@!lig_z:array[0..hash_size] of xxchar_type; -@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|} -@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries} -@!h,@!hh:0..hash_size; {indices into the hash table} -@!tt:indx; {temporary register} -@!x_lig_cycle,@!y_lig_cycle:xchar_type; {problematic ligature pair} - -@ @<Set init...@>= -hash_ptr:=0; y_lig_cycle:=xmax_char; -for k:=0 to hash_size do hash[k]:=0; - -@ @d lig_exam==lig_kern[lig_ptr].b1 -@d lig_gen==lig_kern[lig_ptr].b3 - -@<Check lig...@>= -begin lig_ptr:=char_remainder[c]; -if (lig_kern[lig_ptr].b0 div 256)=0 then -begin -repeat if hash_input(lig_ptr,c) then begin - if lig_kern[lig_ptr].b2<kern_flag then begin - if lig_exam<>bchar then - check_existence(lig_exam)('LIG character examined by'); -@.LIG character examined...@> - check_existence(lig_gen)('LIG character generated by'); -@.LIG character generated...@> - if lig_gen>=128 then if(c<128)or(c=bchar) then - if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true; - end - else if lig_exam<>bchar then - check_existence(lig_exam)('KRN character examined by'); -@.KRN character examined...@> - end; -if (lig_kern[lig_ptr].b0 mod 256)>=stop_flag then lig_ptr:=nl -else lig_ptr:=lig_ptr+1+lig_kern[lig_ptr].b0; -until lig_ptr>=nl; -end; -end - -@ The |hash_input| procedure is copied from \.{TFtoPL}, but it is made -into a boolean function that returns |false| if the ligature command -was masked by a previous one. - -@p function hash_input(@!p,@!c:indx):boolean; - {enter data for character |c| and command in location |p|, unless it isn't new} -label 30; {go here for a quick exit} -var @!cc:simple..both_z; {class of data being entered} -@!zz:char_type; {function value or ligature character being entered} -@!y:char_type; {the character after the cursor} -@!key:integer; {value to be stored in |hash|} -@!t:integer; {temporary register for swapping} -begin if hash_ptr=hash_size then - begin hash_input:=false; goto 30;@+end; -@<Compute the command parameters |y|, |cc|, and |zz|@>; -key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size; -while hash[h]>0 do begin - if hash[h]<=key then begin - if hash[h]=key then begin - hash_input:=false; goto 30; {unused ligature command} - end; - t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion} - t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap} - t:=lig_z[h]; lig_z[h]:=zz; zz:=t; - end; - if h>0 then decr(h)@+else h:=hash_size; - end; -hash[h]:=key; class[h]:=cc; lig_z[h]:=zz; -incr(hash_ptr); hash_list[hash_ptr]:=h; -hash_input:=true; -30:end; - -@ @<Compute the command param...@>= -y:=lig_kern[p].b1; t:=lig_kern[p].b2; cc:=simple; -zz:=lig_kern[p].b3; -if t>=kern_flag then zz:=y -else begin - case t of - 0,6:do_nothing; {\.{LIG},\.{/LIG>}} - 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}} - 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}} - 2:cc:=right_z; {\.{/LIG}} - 3:cc:=both_z; {\.{/LIG/}} - end; {there are no other cases} - end - -@ (More good stuff from \.{TFtoPL}.) - -@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@> - {compute $f$ for arguments known to be in |hash[h]|} -function eval(@!x,@!y:indx):indx; {compute $f(x,y)$ with hashtable lookup} -var @!key:integer; {value sought in hash table} -begin key:=xmax_char*x+y+1; h:=(hash_mult*key) mod hash_size; -while hash[h]>key do - if h>0 then decr(h)@+else h:=hash_size; -if hash[h]<key then eval:=y {not in ordered hash table} -else eval:=f(h,x,y); -end; - -@ Pascal's beastly convention for |forward| declarations prevents us from -saying |function f(h,x,y:indx):indx| here. - -@p function f; -begin -case class[h] of - simple: do_nothing; - left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple; - end; - right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple; - end; - both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y); - class[h]:=simple; - end; - pending: begin x_lig_cycle:=x; y_lig_cycle:=y; - lig_z[h]:=xxmax_char; class[h]:=simple; - end; {the value |xxmax_char| will break all cycles, - since it's not in |hash|} - end; {there are no other cases} -f:=lig_z[h]; -end; - -@ @<Check for infinite...@>= -if hash_ptr<hash_size then for hh:=1 to hash_ptr do begin - tt:=hash_list[hh]; - if class[tt]>simple then {make sure $f$ is well defined} - tt:=f(tt,(hash[tt]-1)div xmax_char,(hash[tt]-1)mod xmax_char); - end; -if(hash_ptr=hash_size)or(y_lig_cycle<xmax_char) then begin - if hash_ptr<hash_size then begin - print('Infinite ligature loop starting with '); -@.Infinite ligature loop...@> - if x_lig_cycle=xmax_char - then print('boundary')@+else print_hex(x_lig_cycle); - print(' and '); print_hex(y_lig_cycle); print_ln('!'); - end - else print_ln('Sorry, I haven''t room for so many ligature/kern pairs!'); -@.Sorry, I haven't room...@> - print_ln('All ligatures will be cleared.'); - for c:=0 to max_char do if char_tag[c]=lig_tag then begin - char_tag[c]:=no_tag; char_remainder[c]:=0; - end; - nl:=0; bchar:=xmax_char; bchar_label:=xmax_label; - end - -@ The lig/kern program may still contain references to nonexistent characters, -if parts of that program are never used. Similarly, there may be extensible -characters that are never used, because they were overridden by -\.{NEXTLARGER}, say. This would produce an invalid \.{TFM} file; so we -must fix such errors. - -@d double_check_tail(#)==@t\1@>if char_wd[0]=0 - then char_wd[0]:=sort_in(width,0); - print('Unused ',#,' refers to nonexistent character '); - print_hex(c); print_ln('!'); - end; - end -@d double_check_lig(#)==begin c:=lig_kern[lig_ptr].#; - if char_wd[c]=0 then if c<>bchar then - begin lig_kern[lig_ptr].#:=0; double_check_tail -@d double_check_ext(#)==begin c:=exten[g].#; - if c>0 then if char_wd[c]=0 then - begin exten[g].#:=0; double_check_tail -@d double_check_rep(#)==begin c:=exten[g].#; - if char_wd[c]=0 then - begin exten[g].#:=0; double_check_tail - -@<Doublecheck...@>= -if nl>0 then for lig_ptr:=0 to nl-1 do - if (lig_kern[lig_ptr].b0 div 256)=0 then begin - if lig_kern[lig_ptr].b2<kern_flag then begin - if lig_kern[lig_ptr].b0<255 then begin - double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step'); - end; - end - else double_check_lig(b1)('KRN step'); - end; -@.Unused LIG step...@> -@.Unused KRN step...@> -if ne>0 then for g:=0 to ne-1 do begin - double_check_ext(b0)('VARCHAR TOP'); - double_check_ext(b1)('VARCHAR MID'); - double_check_ext(b2)('VARCHAR BOT'); - double_check_rep(b3)('VARCHAR REP'); -@.Unused VARCHAR...@> - end - -@* The output phase. -Now that we know how to get all of the font data correctly stored in -\.{PLtoTF}'s memory, it only remains to write the answers out. - -First of all, it is convenient to have an abbreviation for output to the -\.{TFM} file: - -@d out(#)==write(tfm_file,#) - -@ The general plan for producing \.{TFM} files is long but simple: - -@<Do the font metric output@>= -compute_subfile_sizes; -output_subfile_sizes; -@<Output the header block@>; -output_new_information_ofm; -output_character_info; -@<Output the dimensions themselves@>; -@<Output the ligature/kern program@>; -@<Output the extensible character recipes@>; -@<Output the parameters@>; - -@ A \.{TFM} file begins with 12 numbers that tell how big its subfiles are. -We already know most of these numbers; for example, the number of distinct -widths is |memory[width]+1|, where the $+1$ accounts for the zero width that -is always supposed to be present. But we still should compute the beginning -and ending character codes (|bc| and |ec|), the number of header words (|lh|), -and the total number of words in the \.{TFM} file (|lf|). - -@<Gl...@>= -@!bc:byte; {the smallest character code in the font} -@!ec:byte; {the largest character code in the font} -@!lh:byte; {the number of words in the header block} -@!lf:unsigned_integer; {the number of words in the entire \.{TFM} file} -@!not_found:boolean; {has a font character been found?} -@!temp_width:fix_word; {width being used to compute a check sum} -@!ncw,@!nco,@!npc:integer; - -@ It might turn out that no characters exist at all. But \.{PLtoTF} keeps -going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc| -will be~1. - -@<Compute the subfile sizes@>= -case ofm_level of - -1: begin - lh:=header_ptr div 4;@/ - not_found:=true; bc:=0; - while not_found do - if (char_wd[bc]>0)or(bc=255) then not_found:=false - else incr(bc); - not_found:=true; ec:=255; - while not_found do - if (char_wd[ec]>0)or(ec=0) then not_found:=false - else decr(ec); - if bc>ec then bc:=1; - incr(memory[width]); incr(memory[height]); incr(memory[depth]); - incr(memory[italic]);@/ - @<Compute the ligature/kern program offset@>; - lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+ - memory[italic]+nl+lk_offset+nk+ne+np; - end; - 0: begin - lh:=header_ptr div 4;@/ - not_found:=true; bc:=0; - while not_found do - if (char_wd[bc]>0)or(bc=max_char) then not_found:=false - else incr(bc); - not_found:=true; ec:=max_char; - while not_found do - if (char_wd[ec]>0)or(ec=0) then not_found:=false - else decr(ec); - if bc>ec then bc:=1; - incr(memory[width]); incr(memory[height]); incr(memory[depth]); - incr(memory[italic]);@/ - @<Compute the ligature/kern program offset@>; - lf:=14+lh+2*(ec-bc+1)+memory[width]+memory[height]+memory[depth]+ - memory[italic]+2*nl+lk_offset+nk+2*ne+np; - end; - 1: begin - lh:=header_ptr div 4;@/ - not_found:=true; bc:=0; - while not_found do - if (char_wd[bc]>0)or(bc=max_char) then not_found:=false - else incr(bc); - not_found:=true; ec:=max_char; - while not_found do - if (char_wd[ec]>0)or(ec=0) then not_found:=false - else decr(ec); - if bc>ec then bc:=1; - incr(memory[width]); incr(memory[height]); incr(memory[depth]); - incr(memory[italic]);@/ - @<Compute the ligature/kern program offset@>; - @<Compute the character info size@>; - lf:=29+lh+ncw+memory[width]+memory[height]+memory[depth]+ - memory[italic]+2*(nl+lk_offset)+nk+2*ne+np+ - nki+nwi+nkf+nwf+nkm+nwm++nkr+nwr+nkg+nwg+nkp+nwp; - nco:=29+lh+nki+nwi+nkf+nwf+nkm+nwm++nkr+nwr+nkg+nwg+nkp+nwp; - end; - end; - -@ @d out_size(#)==out((#) div 256); out((#) mod 256) - @d out_integer(#)==out((#) div @"1000000); - out(((#) mod @"1000000) div @"10000); - out(((#) mod @"10000) div @"100); - out((#) mod @"100) - -@<Output the subfile sizes@>= -case ofm_level of - -1: begin - out_size(lf); out_size(lh); out_size(bc); out_size(ec); - out_size(memory[width]); out_size(memory[height]); - out_size(memory[depth]); out_size(memory[italic]); - out_size(nl+lk_offset); out_size(nk); out_size(ne); out_size(np); - end; - 0: begin - out_integer(0); - out_integer(lf); out_integer(lh); out_integer(bc); out_integer(ec); - out_integer(memory[width]); out_integer(memory[height]); - out_integer(memory[depth]); out_integer(memory[italic]); - out_integer(nl+lk_offset); out_integer(nk); - out_integer(ne); out_integer(np); out_integer(font_dir); - end; - 1: begin - out_integer(1); - out_integer(lf); out_integer(lh); - out_integer(bc); out_integer(ec); - out_integer(memory[width]); out_integer(memory[height]); - out_integer(memory[depth]); out_integer(memory[italic]); - out_integer(nl+lk_offset); out_integer(nk); - out_integer(ne); out_integer(np); out_integer(font_dir); - out_integer(nco); out_integer(ncw); out_integer(npc); - out_integer(nki); out_integer(nwi); out_integer(nkf); out_integer(nwf); - out_integer(nkm); out_integer(nwm); out_integer(nkr); out_integer(nwr); - out_integer(nkg); out_integer(nwg); out_integer(nkp); out_integer(nwp); - end; - end; - -@ The routines that follow need a few temporary variables of different types. - -@<Gl...@>= -@!j:0..max_header_bytes; {index into |header_bytes|} -@!p:pointer; {index into |memory|} -@!q:width..italic; {runs through the list heads for dimensions} -@!par_ptr:0..max_param_words; {runs through the parameters} - -@ The header block follows the subfile sizes. The necessary information all -appears in |header_bytes|, except that the design size and the seven-bit-safe -flag must still be set. - -@<Output the header block@>= -if not check_sum_specified then @<Compute the check sum@>; -header_bytes[design_size_loc]:=design_size div @'100000000; - {this works since |design_size>0|} -header_bytes[design_size_loc+1]:=(design_size div @'200000) mod 256; -header_bytes[design_size_loc+2]:=(design_size div 256) mod 256; -header_bytes[design_size_loc+3]:=design_size mod 256; -if not seven_unsafe then header_bytes[seven_flag_loc]:=128; -for j:=0 to header_ptr-1 do out(header_bytes[j]); - -@ @<Compute the check sum@>= -begin c0:=bc; c1:=ec; c2:=bc; c3:=ec; -for c:=bc to ec do if char_wd[c]>0 then begin - temp_width:=memory[char_wd[c]]; - if design_units<>unity then - temp_width:=round((temp_width/design_units)*1048576.0); - temp_width:=temp_width + (c+4)*@'20000000; {this should be positive} - c0:=(c0+c0+temp_width) mod 255; - c1:=(c1+c1+temp_width) mod 253; - c2:=(c2+c2+temp_width) mod 251; - c3:=(c3+c3+temp_width) mod 247; - end; -header_bytes[check_sum_loc]:=c0; -header_bytes[check_sum_loc+1]:=c1; -header_bytes[check_sum_loc+2]:=c2; -header_bytes[check_sum_loc+3]:=c3; -end - -@ @<Global...@>= -@!tab:integer; - -@ -@<Compute the character info size@>= -if ofm_level=1 then begin - ncw:=0; - if nkcp>-1 then - npc:=nki+nkf+nkr+nkg+nkcp+1 - else if nkcg>-1 then - npc:=nki+nkf+nkr+nkcg+1 - else if nkcr>-1 then - npc:=nki+nkf+nkcr+1 - else if nkcf>-1 then - npc:=nki+nkcf+1 - else if nkci>-1 then - npc:=nkci+1 - else - npc:=0; - needed_space:=(12+npc*2) div 4; - extra_bytes:=(needed_space*4) - (10+npc*2); - for c:=bc to ec do begin - if char_original[c]=c then begin - cprime:=c+1; - diff:=false; - while (not diff) and (cprime<=ec) do begin - if index[char_wd[c]]<>index[char_wd[cprime]] then diff:=true; - if index[char_ht[c]]<>index[char_ht[cprime]] then diff:=true; - if index[char_dp[c]]<>index[char_dp[cprime]] then diff:=true; - if index[char_ic[c]]<>index[char_ic[cprime]] then diff:=true; - if char_remainder[c]<>char_remainder[cprime] then diff:=true; - for tab:=0 to npc-1 do begin - if char_table[c,tab]<>char_table[cprime,tab] then diff:=true; - end; - if not diff then begin - char_original[cprime]:=c; - cprime:=cprime+1; - end; - end; - if cprime>(c+1) then begin - char_repeats[c]:=cprime-c-1; - end; - ncw:=ncw+needed_space; - end; - end; - end; - -@ The next block contains packed |char_info|. - -@<Output the character info@>= -index[0]:=0; -for c:=bc to ec do -case ofm_level of - -1: begin - out(index[char_wd[c]]); - out(index[char_ht[c]]*16+index[char_dp[c]]); - out(index[char_ic[c]]*4+char_tag[c]); - out(char_remainder[c]); - end; - 0: begin - out(index[char_wd[c]] div 256); out(index[char_wd[c]] mod 256); - out(index[char_ht[c]]); out(index[char_dp[c]]); - out(index[char_ic[c]] div 64);out((index[char_ic[c]] mod 64)*4+char_tag[c]); - out(char_remainder[c] div 256); out(char_remainder[c] mod 256); - end; - 1: begin - if c=char_original[c] then begin - out(index[char_wd[c]] div 256); out(index[char_wd[c]] mod 256); - out(index[char_ht[c]]); out(index[char_dp[c]]); - out(index[char_ic[c]]); - tab:=char_tag[c]; - if char_extended_tag[c] then begin - tab:=5; - end; - out(tab); - out(char_remainder[c] div 256); out(char_remainder[c] mod 256); - out_size(char_repeats[c]); - for tab:=0 to npc-1 do begin - out(char_table[c,tab] div 256); out(char_table[c,tab] mod 256); - end; - for tab:=1 to extra_bytes do begin - out(0); - end; - end; - end; - end; - - -@ When a scaled quantity is output, we may need to divide it by |design_units|. -The following subroutine takes care of this, using floating point arithmetic -only if |design_units<>1.0|. - -@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|} -var @!n:byte; {the first byte after the sign} -@!m:0..65535; {the two least significant bytes} -begin if abs(x/design_units)>=16.0 then begin - print_ln('The relative dimension ',x/@'4000000:1:3, - ' is too large.'); -@.The relative dimension...@> - print(' (Must be less than 16*designsize'); - if design_units<>unity then print(' =',design_units/@'200000:1:3, - ' designunits'); - print_ln(')'); x:=0; - end; -if design_units<>unity then x:=round((x/design_units)*1048576.0); -if x<0 then begin - out(255); x:=x+@'100000000; - if x<=0 then x:=1; - end -else begin out(0); - if x>=@'100000000 then x:=@'77777777; - end; -n:=x div @'200000; m:=x mod @'200000; -out(n); out(m div 256); out(m mod 256); -end; - -@ We have output the packed indices for individual characters. -The scaled widths, heights, depths, and italic corrections are next. - -@<Output the dimensions themselves@>= -for q:=width to italic do begin - out(0); out(0); out(0); out(0); {output the zero word} - p:=link[q]; {head of list} - while p>0 do begin - out_scaled(memory[p]); - p:=link[p]; - end; - end; - -@ One embarrassing problem remains: The ligature/kern program might be very -long, but the starting addresses in |char_remainder| can be at most~255. -Therefore we need to output some indirect address information; we want to -compute |lk_offset| so that addition of |lk_offset| to all remainders makes -all but |lk_offset| distinct remainders less than~256. - -For this we need a sorted table of all relevant remainders. - -@<Glob...@>= -@!label_table:array[xchar_type] of record - @!rr: -1..xmax_label; {sorted label values} - @!cc: integer; {associated characters} - end; -@!label_ptr:xchar_type; {index of highest entry in |label_table|} -@!sort_ptr:xchar_type; {index into |label_table|} -@!lk_offset:xchar_type; {smallest offset value that might work} -@!t:0..xmax_label; {label value that is being redirected} -@!extra_loc_needed:boolean; {do we need a special word for |bchar|?} - -@ @<Compute the ligature/kern program offset@>= -@<Insert all labels into |label_table|@>; -if bchar<xmax_char then begin - extra_loc_needed:=true; lk_offset:=1; - end -else begin - extra_loc_needed:=false; lk_offset:=0; - end; -@<Find the minimum |lk_offset| and adjust all remainders@>; -if bchar_label<xmax_label then begin - if ofm_level=-1 then begin - lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 256; - lig_kern[nl-1].b3:=(bchar_label+lk_offset)mod 256; - end - else begin - lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 65536; - lig_kern[nl-1].b3:=(bchar_label+lk_offset)mod 65536; - end - end - -@ @<Insert all labels...@>= -label_ptr:=0; label_table[0].rr:=-1; {sentinel} -for c:=bc to ec do if char_tag[c]=lig_tag then begin - sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|} - while label_table[sort_ptr].rr>char_remainder[c] do begin - label_table[sort_ptr+1]:=label_table[sort_ptr]; - decr(sort_ptr); {move the hole} - end; - label_table[sort_ptr+1].cc:=c; - label_table[sort_ptr+1].rr:=char_remainder[c]; - incr(label_ptr); - end - -@ @<Find the minimum |lk_offset| and adjust all remainders@>= -begin sort_ptr:=label_ptr; {the largest unallocated label} -if ofm_level=-1 then begin - if label_table[sort_ptr].rr+lk_offset > 255 then begin - lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty} - repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset; - while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do begin - decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset; - end; - incr(lk_offset); decr(sort_ptr); - until lk_offset+label_table[sort_ptr].rr<256; - {N.B.: |lk_offset=256| satisfies this when |sort_ptr=0|} - end; - end -else begin - if label_table[sort_ptr].rr+lk_offset > 65535 then begin - lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty} - repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset; - while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do begin - decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset; - end; - incr(lk_offset); decr(sort_ptr); - until lk_offset+label_table[sort_ptr].rr<65536; - {N.B.: |lk_offset=65536| satisfies this when |sort_ptr=0|} - end; - end; -if lk_offset>0 then while sort_ptr>0 do begin - char_remainder[label_table[sort_ptr].cc]:= - char_remainder[label_table[sort_ptr].cc]+lk_offset; - decr(sort_ptr); - end; -end - -@ @<Output the ligature/kern program@>= -if ofm_level=-1 then begin - if extra_loc_needed then begin {|lk_offset=1|} - out(255); out(bchar); out(0); out(0); - end - else for sort_ptr:=1 to lk_offset do begin {output the redirection specs} - t:=label_table[label_ptr].rr; - if bchar<256 then begin - out(255); out(bchar); - end - else begin - out(254); out(0); - end; - out_size(t+lk_offset); - repeat decr(label_ptr); until label_table[label_ptr].rr<t; - end; - if nl>0 then for lig_ptr:=0 to nl-1 do begin - out(lig_kern[lig_ptr].b0); - out(lig_kern[lig_ptr].b1); - out(lig_kern[lig_ptr].b2); - out(lig_kern[lig_ptr].b3); - end; - if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr]) - end -else begin - if extra_loc_needed then {|lk_offset=1|} begin - out_size(255); out_size(bchar); out_size(0); out_size(0); - end - else - for sort_ptr:=1 to lk_offset do {output the redirection specs} begin - t:=label_table[label_ptr].rr; - if bchar<xmax_char then begin - out_size(255); out_size(bchar); - end - else begin - out_size(254); out_size(0); - end; - out_size((t+lk_offset) div 256); - out_size((t+lk_offset) mod 256); - repeat decr(label_ptr); until label_table[label_ptr].rr<t; - end; - if nl>0 then for lig_ptr:=0 to nl-1 do begin - out_size(lig_kern[lig_ptr].b0); - out_size(lig_kern[lig_ptr].b1); - out_size(lig_kern[lig_ptr].b2); - out_size(lig_kern[lig_ptr].b3); - end; - if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr]) - end - -@ @<Output the extensible character recipes@>= -if ofm_level=-1 then begin - if ne>0 then for c:=0 to ne-1 do begin - out(exten[c].b0); - out(exten[c].b1); - out(exten[c].b2); - out(exten[c].b3); - end; - end -else begin - if ne>0 then for c:=0 to ne-1 do begin - out_size(exten[c].b0); - out_size(exten[c].b1); - out_size(exten[c].b2); - out_size(exten[c].b3); - end; - end; - -@ For our grand finale, we wind everything up by outputting the parameters. - -@<Output the parameters@>= -for par_ptr:=1 to np do begin - if par_ptr=1 then - @<Output the slant (|param[1]|) without scaling@> - else out_scaled(param[par_ptr]); - end - -@ @<Output the slant...@>= -begin if param[1]<0 then begin - param[1]:=param[1]+@'10000000000; - out((param[1] div @'100000000)+256-64); - end -else out(param[1] div @'100000000); -out((param[1] div @'200000) mod 256); -out((param[1] div 256) mod 256); -out(param[1] mod 256); -end - -@* The main program. -The routines sketched out so far need to be packaged into separate procedures, -on some systems, since some \PASCAL\ compilers place a strict limit on the -size of a routine. The packaging is done here in an attempt to avoid some -system-dependent changes. - -@p procedure param_enter; -begin @<Enter the parameter names@>; -end; -@# -procedure name_enter; {enter all names and their equivalents} -begin @<Enter all of the names...@>; -param_enter; -end; -@# -procedure read_lig_kern; -var @!krn_ptr:0..max_kerns; {an index into |kern|} -@!c:integer; {runs through all character codes} -begin @<Read ligature/kern list@>; -end; -@# -procedure output_new_information_ofm; -begin @<Output the new information for OFM files@>; -end; -@# -procedure compute_new_header_ofm; -begin @<Compute the new header information for OFM files@>; -end; -@# -procedure finish_extended_font; -begin @<Finish up the extended font stuff@>; -end; -@# -procedure output_subfile_sizes; -begin @<Output the subfile sizes@>; -end; -@# -procedure compute_subfile_sizes; -begin @<Compute the subfile sizes@>; -end; -@# -procedure output_character_info; -begin @<Output the character info@>; -end; -@# -procedure read_font_rule_list; -begin @<Read font rule list@>; -end; -@# -procedure read_font_glue_list; -begin @<Read font glue list@>; -end; -@# -procedure read_font_penalty_list; -begin @<Read font penalty list@>; -end; -@# -procedure read_font_mvalue_list; -begin @<Read font mvalue list@>; -end; -@# -procedure read_font_fvalue_list; -begin @<Read font fvalue list@>; -end; -@# -procedure read_font_ivalue_list; -begin @<Read font ivalue list@>; -end; -@# -procedure read_repeated_character_info; -begin @<Read repeated character info@>; -end; -@# -procedure read_lig_kern_command; -begin @<Read a ligature/kern command@>; -end; -@# -procedure read_character_property; -begin @<Read a character property@>; -end; -@# -procedure read_char_info; -begin @<Read character info list@>; -end; -@# -procedure read_input; -var @!c:integer; {header or parameter index} -begin @<Read all the input@>; -end; -@# -procedure corr_and_check; -var @!c:integer; {runs through all character codes} -@!hh:0..hash_size; {an index into |hash_list|} -@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|} -@!g:byte; {a character generated by the current character |c|} -begin @<Correct and check the information@> -end; - -@ Here is where \.{PLtoTF} begins and ends. - -@p begin initialize;@/ -name_enter;@/ -read_input; print('.');@/ -corr_and_check;@/ -@<Do the font metric output@>; -end. - -@ @<Global...@>= -@!ofm_level:integer; - -@ @<Set init...@>= -ofm_level:=-1; {Suppose that it is a TFM file} - -@ @<Read OFM level code@>= -begin -ofm_level:=get_integer; -if (ofm_level<0) or (ofm_level>1) then begin - flush_error('OFMLEVEL must be 0 or 1 -- 1 assumed'); - ofm_level:=1; - end; -end - -@ @<Read font direction code@>= -begin -font_dir:=-1; -repeat get_next; -until cur_char<>" "; -case cur_char of - "T": begin get_next; - if cur_char="L" then font_dir:=0 - else if cur_char="R" then font_dir:=2; - end; - "B": begin get_next; - if cur_char="L" then font_dir:=4 - else if cur_char="R" then font_dir:=6; - end; - "R": begin get_next; - if cur_char="T" then font_dir:=5 - else if cur_char="B" then font_dir:=7; - end; - "L": begin get_next; - if cur_char="T" then font_dir:=1 - else if cur_char="B" then font_dir:=3; - end; - end; -while cur_char<>")" do get_next; -if font_dir = -1 then begin - flush_error('FONTDIR must be valid direction, -- TR assumed'); - font_dir:=0; - end; -end - -@ @<Read natural font direction code@>= -begin -font_dir:=-1; -repeat get_next; -until cur_char<>" "; -case cur_char of - "T": begin get_next; - if cur_char="L" then font_dir:=8 - else if cur_char="R" then font_dir:=10; - end; - "B": begin get_next; - if cur_char="L" then font_dir:=12 - else if cur_char="R" then font_dir:=14; - end; - "R": begin get_next; - if cur_char="T" then font_dir:=13 - else if cur_char="B" then font_dir:=15; - end; - "L": begin get_next; - if cur_char="T" then font_dir:=9 - else if cur_char="B" then font_dir:=11; - end; - end; -while cur_char<>")" do get_next; -if font_dir = -1 then begin - flush_error('NFONTDIR must be valid direction, -- TR assumed'); - font_dir:=8; - end; -end - -@ -Here are some general values for the various entries. -They can all be changed. - -@d arrays_per_kind==20 -@d entries_per_array==200 - -@ @<Constants...@>= -@!rule_arrays=arrays_per_kind; -@!rule_entries=entries_per_array; - -@ @<Types...@>= -rule_array_type=0..rule_arrays; -rule_entry_type=0..rule_entries; -rule_node= -record - rn_width: fix_word; - rn_height: fix_word; - rn_depth: fix_word; -end; - -@ @<Global...@>= -@!rules:array[rule_array_type,rule_entry_type] of rule_node; -@!npr:array[rule_array_type] of integer; -@!nkr:integer; -@!nkcr:integer; -@!nwr:integer; -@!r_array:integer; -@!r_number:integer; - -@ @<Set init...@>= -for r_array := 0 to rule_arrays do begin - npr[r_array]:=0; - @<Null out the rule@>; - end; -nkr:=-1; -nkcr:=-1; - -@ @<Read font rule list@>= -begin -if tables_read then - flush_error('All parameter tables must appear before character info'); -r_array:=get_integer; -if r_array>rule_arrays then - flush_error('This FONTRULE table index is too big for my present size') -else if r_array<0 then - flush_error('This FONTRULE index is negative') -else begin - if r_array>nkr then nkr:=r_array; - while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a rule@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; - finish_inner_property_list; - end; -end - -@ @<Read a rule@>= -begin -get_name; -if cur_code=comment_code then skip_to_end_of_item -else if cur_code<>rule_code then - flush_error('This property name doesn''t belong in a RULE list') -else begin - r_number:=get_integer; - if r_number>rule_entries then - flush_error('This RULE index is too big for my present table size') - else if r_number<0 then - flush_error('This RULE index is negative') - else begin - while npr[r_array]<r_number do begin - incr(npr[r_array]); @<Null out the rule@>; - end; - @<Read all of a rule's values@>; - finish_the_property; - end; - end; -end - -@ @<Null out the rule@>= -begin -rules[r_array,npr[r_array]].rn_width:=0; -rules[r_array,npr[r_array]].rn_depth:=0; -rules[r_array,npr[r_array]].rn_height:=0; -end - -@ @<Read all of a rule's values@>= -begin -while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a single rule value@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a single rule value@>= -begin -get_name; -case cur_code of - rule_width_code: - rules[r_array,r_number].rn_width:=get_fix; - rule_height_code: - rules[r_array,r_number].rn_height:=get_fix; - rule_depth_code: - rules[r_array,r_number].rn_depth:=get_fix; - end; -finish_the_property; -end - -@ @<Header information for rules@>= -begin -nwr:=0; -for r_array := 0 to nkr do begin - incr(npr[r_array]); - nwr := nwr + 3*npr[r_array]; - end; -incr(nkr); -end - -@ @<Output the rules@>= -begin -for r_array:= 0 to nkr-1 do - for r_number:=0 to npr[r_array]-1 do begin - out_scaled(rules[r_array,r_number].rn_width); - out_scaled(rules[r_array,r_number].rn_height); - out_scaled(rules[r_array,r_number].rn_depth); - end; -end - -@ @<Output the rule headers@>= -begin -for r_array:= 0 to nkr-1 do begin - out_integer(npr[r_array]); - end; -end - -@ @<Constants...@>= -@!glue_arrays=arrays_per_kind; -@!glue_entries=entries_per_array; - -@ -@d t_normal==0 -@d t_aleaders==1 -@d t_cleaders==2 -@d t_xleaders==3 - -@d o_unit==0 -@d o_fi==1 -@d o_fil==2 -@d o_fill==3 -@d o_filll==4 - -@d g_space==0 -@d g_rule==1 -@d g_char==2 - -@<Types...@>= -glue_array_type=0..glue_arrays; -glue_entry_type=0..glue_entries; -glue_node= -record - gn_width: fix_word; - gn_stretch: fix_word; - gn_shrink: fix_word; - gn_type: integer; - gn_arg_type: g_space..g_char; - gn_stretch_order: integer; - gn_shrink_order: integer; - gn_argument: integer; -end; - -@ @<Global...@>= -@!glues:array[glue_array_type,glue_entry_type] of glue_node; -@!npg:array[glue_array_type] of integer; -@!nkg:integer; -@!nkcg:integer; -@!nwg:integer; -@!g_array:integer; -@!g_byte:integer; -@!g_number:integer; - -@ @<Set init...@>= -for g_array := 0 to glue_arrays do -begin - npg[g_array]:=0; - @<Null out the glue@>; -end; -nkg:=-1; -nkcg:=-1; - -@ @<Read font glue list@>= -begin -if tables_read then - flush_error('All parameter tables must appear before character info'); -g_array:=get_integer; -if g_array>glue_arrays then - flush_error('This FONTGLUE table index is too big for my present size') -else if g_array<0 then - flush_error('This FONTGLUE index is negative') -else begin - if g_array>nkg then nkg:=g_array; - while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a glue@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; - finish_inner_property_list; - end; -end - -@ @<Read a glue@>= -begin -get_name; -if cur_code=comment_code then skip_to_end_of_item -else if cur_code<>glue_code then - flush_error('This property name doesn''t belong in a GLUE list') -else begin - g_number:=get_integer; - if g_number>glue_entries then - flush_error('This GLUE index is too big for my present table size') - else if g_number<0 then - flush_error('This GLUE index is negative') - else begin - while npg[g_array]<g_number do begin - incr(npg[g_array]); @<Null out the glue@>; - end; - @<Read all of a glue's values@>; - finish_the_property; - end; - end; -end - -@ @<Null out the glue@>= -begin -glues[g_array,npg[g_array]].gn_width:=0; -glues[g_array,npg[g_array]].gn_stretch:=0; -glues[g_array,npg[g_array]].gn_shrink:=0; -glues[g_array,npg[g_array]].gn_type:=0; -glues[g_array,npg[g_array]].gn_arg_type:=0; -glues[g_array,npg[g_array]].gn_stretch_order:=0; -glues[g_array,npg[g_array]].gn_shrink_order:=0; -glues[g_array,npg[g_array]].gn_argument:=0; -end - -@ @<Read all of a glue's values@>= -begin -while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a single glue value@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a single glue value@>= -begin -get_name; -case cur_code of - glue_width_code: - glues[g_array,g_number].gn_width:=get_fix; - glue_stretch_code: - glues[g_array,g_number].gn_stretch:=get_fix; - glue_shrink_code: - glues[g_array,g_number].gn_shrink:=get_fix; - glue_type_code: begin - g_byte:=get_integer; - if (g_byte<0) or (g_byte>3) then begin - g_byte:=0; - end; - glues[g_array,g_number].gn_type:=g_byte; - end; - glue_stretch_order_code: begin - g_byte:=get_integer; - if (g_byte<0) or (g_byte>4) then begin - g_byte:=0; - end; - glues[g_array,g_number].gn_stretch_order:=g_byte; - end; - glue_shrink_order_code: begin - g_byte:=get_integer; - if (g_byte<0) or (g_byte>4) then begin - g_byte:=0; - end; - glues[g_array,g_number].gn_shrink_order:=g_byte; - end; - glue_char_code: begin - glues[g_array,g_number].gn_argument:=get_integer; - glues[g_array,g_number].gn_arg_type:=g_char; - end; - glue_rule_code: begin - glues[g_array,g_number].gn_argument:=get_integer; - glues[g_array,g_number].gn_arg_type:=g_rule; - end; - end; -finish_the_property; -end - -@ @<Header information for glues@>= -begin -nwg:=0; -for g_array := 0 to nkg do begin - incr(npg[g_array]); - nwg := nwg + 4*npg[g_array]; - end; -incr(nkg); -end - -@ @<Output the glues@>= -begin -for g_array:= 0 to nkg-1 do - for g_number:=0 to npg[g_array]-1 do begin - g_byte:=glues[g_array,g_number].gn_type*16+ - glues[g_array,g_number].gn_arg_type; - out(g_byte); - g_byte:=glues[g_array,g_number].gn_stretch_order*16+ - glues[g_array,g_number].gn_shrink_order; - out(g_byte); - g_byte:=glues[g_array,g_number].gn_argument div 256; - out(g_byte); - g_byte:=glues[g_array,g_number].gn_argument mod 256; - out(g_byte); - out_scaled(glues[g_array,g_number].gn_width); - out_scaled(glues[g_array,g_number].gn_stretch); - out_scaled(glues[g_array,g_number].gn_shrink); - end; -end - -@ @<Output the glue headers@>= -begin -for g_array:= 0 to nkg-1 do begin - out_integer(npg[g_array]); - end; -end - -@ @<Constants...@>= -@!penalty_arrays=arrays_per_kind; -@!penalty_entries=entries_per_array; - -@ @<Types...@>= -penalty_array_type=0..penalty_arrays; -penalty_entry_type=0..penalty_entries; -penalty_node= -record - pn_val: integer; -end; - -@ @<Global...@>= -@!penalties:array[penalty_array_type,penalty_entry_type] of penalty_node; -@!npp:array[penalty_array_type] of integer; -@!nkp:integer; -@!nkcp:integer; -@!nwp:integer; -@!p_array:integer; -@!p_number:integer; - -@ @<Set init...@>= -for p_array := 0 to penalty_arrays do begin - npp[p_array]:=0; - @<Null out the penalty@>; - end; -nkp:=-1; -nkcp:=-1; - -@ @<Read font penalty list@>= -begin -if tables_read then - flush_error('All parameter tables must appear before character info'); -p_array:=get_integer; -if p_array>penalty_arrays then - flush_error('This FONTPENALTY table index is too big for my present size') -else if p_array<0 then - flush_error('This FONTPENALTY index is negative') -else begin - if p_array>nkp then nkp:=p_array; - while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a penalty@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; - finish_inner_property_list; - end; -end - -@ @<Read a penalty@>= -begin -get_name; -if cur_code=comment_code then skip_to_end_of_item -else if cur_code<>penalty_code then - flush_error('This property name doesn''t belong in a PENALTY list') -else begin - p_number:=get_integer; - if p_number>penalty_entries then - flush_error('This PENALTY index is too big for my present table size') - else if p_number<0 then - flush_error('This PENALTY index is negative') - else begin - while npp[p_array]<p_number do begin - incr(npp[p_array]); @<Null out the penalty@>; - end; - @<Read all of a penalty's values@>; - finish_the_property; - end; - end; -end - -@ @<Null out the penalty@>= -begin -penalties[p_array,npp[p_array]].pn_val:=0; -end - -@ @<Read all of a penalty's values@>= -begin -while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a single penalty value@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a single penalty value@>= -begin -get_name; -case cur_code of - penalty_val_code: - penalties[p_array,p_number].pn_val:=get_integer; - end; -finish_the_property; -end - -@ @<Header information for penalties@>= -begin -nwp:=0; -for p_array := 0 to nkp do begin - incr(npp[p_array]); - nwp := nwp + npp[p_array]; - end; -incr(nkp); -end - -@ @<Output the penalties@>= -begin -for p_array:= 0 to nkp-1 do - for p_number:=0 to npp[p_array]-1 do begin - out_integer(penalties[p_array,p_number].pn_val); - end; -end - -@ @<Output the penalty headers@>= -begin -for p_array:= 0 to nkp-1 do begin - out_integer(npp[p_array]); - end; -end - -@ @<Constants...@>= -@!mvalue_arrays=arrays_per_kind; -@!mvalue_entries=entries_per_array; - -@ @<Types...@>= -mvalue_array_type=0..mvalue_arrays; -mvalue_entry_type=0..mvalue_entries; -mvalue_node= -record - fn_val: fix_word; -end; - -@ @<Global...@>= -@!mvalues:array[mvalue_array_type,mvalue_entry_type] of mvalue_node; -@!npm:array[mvalue_array_type] of integer; -@!nkm:integer; -@!nkcm:integer; -@!nwm:integer; -@!m_array:integer; -@!m_number:integer; - -@ @<Set init...@>= -for m_array := 0 to mvalue_arrays do begin - npm[m_array]:=0; - @<Null out the mvalue@>; - end; -nkm:=-1; -nkcm:=-1; - -@ @<Read font mvalue list@>= -begin -if tables_read then - flush_error('All parameter tables must appear before character info'); -m_array:=get_integer; -if m_array>mvalue_arrays then - flush_error('This FONTMVALUE table index is too big for my present size') -else if m_array<0 then - flush_error('This FONTMVALUE index is negative') -else begin - if m_array>nkm then nkm:=m_array; - while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read an mvalue@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; - finish_inner_property_list; - end; -end - -@ @<Read an mvalue@>= -begin -get_name; -if cur_code=comment_code then skip_to_end_of_item -else if cur_code<>mvalue_code then - flush_error('This property name doesn''t belong in an MVALUE list') -else begin - m_number:=get_integer; - if m_number>mvalue_entries then - flush_error('This MVALUE index is too big for my present table size') - else if m_number<0 then - flush_error('This MVALUE index is negative') - else begin - while npm[m_array]<m_number do begin - incr(npm[m_array]); @<Null out the mvalue@>; - end; - @<Read all of an mvalue's values@>; - finish_the_property; - end; - end; -end - -@ @<Null out the mvalue@>= -begin -mvalues[m_array,npm[m_array]].fn_val:=0; -end - -@ @<Read all of an mvalue's values@>= -begin -while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a single mvalue value@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a single mvalue value@>= -begin -get_name; -case cur_code of - mvalue_val_code: - mvalues[m_array,m_number].fn_val:=get_fix; - end; -finish_the_property; -end - -@ @<Header information for mvalues@>= -begin -nwm:=0; -for m_array := 0 to nkm do begin - incr(npm[m_array]); - nwm := nwm + npm[m_array]; - end; -incr(nkm); -end - -@ @<Output the mvalues@>= -begin -for m_array:= 0 to nkm-1 do - for m_number:=0 to npm[m_array]-1 do begin - out_scaled(mvalues[m_array,m_number].fn_val); - end; -end - -@ @<Output the mvalue headers@>= -begin -for m_array:= 0 to nkm-1 do begin - out_integer(npm[m_array]); - end; -end - -@ @<Constants...@>= -@!fvalue_arrays=arrays_per_kind; -@!fvalue_entries=entries_per_array; - -@ @<Types...@>= -fvalue_array_type=0..fvalue_arrays; -fvalue_entry_type=0..fvalue_entries; -fvalue_node= -record - fn_val: fix_word; -end; - -@ @<Global...@>= -@!fvalues:array[fvalue_array_type,fvalue_entry_type] of fvalue_node; -@!npf:array[fvalue_array_type] of integer; -@!nkf:integer; -@!nkcf:integer; -@!nwf:integer; -@!f_array:integer; -@!f_number:integer; - -@ @<Set init...@>= -for f_array := 0 to fvalue_arrays do begin - npf[f_array]:=0; - @<Null out the fvalue@>; - end; -nkf:=-1; -nkcf:=-1; - -@ @<Read font fvalue list@>= -begin -if tables_read then - flush_error('All parameter tables must appear before character info'); -f_array:=get_integer; -if f_array>fvalue_arrays then - flush_error('This FONTFVALUE table index is too big for my present size') -else if f_array<0 then - flush_error('This FONTFVALUE index is negative') -else begin - if f_array>nkf then nkf:=f_array; - while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read an fvalue@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; - finish_inner_property_list; - end; -end - -@ @<Read an fvalue@>= -begin -get_name; -if cur_code=comment_code then skip_to_end_of_item -else if cur_code<>fvalue_code then - flush_error('This property name doesn''t belong in an FVALUE list') -else begin - f_number:=get_integer; - if f_number>fvalue_entries then - flush_error('This FVALUE index is too big for my present table size') - else if f_number<0 then - flush_error('This FVALUE index is negative') - else begin - while npf[f_array]<f_number do begin - incr(npf[f_array]); @<Null out the fvalue@>; - end; - @<Read all of an fvalue's values@>; - finish_the_property; - end; - end; -end - -@ @<Null out the fvalue@>= -begin -fvalues[f_array,npf[f_array]].fn_val:=0; -end - -@ @<Read all of an fvalue's values@>= -begin -while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a single fvalue value@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a single fvalue value@>= -begin -get_name; -case cur_code of - fvalue_val_code: - fvalues[f_array,f_number].fn_val:=get_fix; - end; -finish_the_property; -end - -@ @<Header information for fvalues@>= -begin -nwf:=0; -for f_array := 0 to nkf do begin - incr(npf[f_array]); - nwf := nwf + npf[f_array]; - end; -incr(nkf); -end - -@ @<Output the fvalues@>= -begin -for f_array:= 0 to nkf-1 do - for f_number:=0 to npf[f_array]-1 do begin - out_scaled(fvalues[f_array,f_number].fn_val); - end; -end - -@ @<Output the fvalue headers@>= -begin -for f_array:= 0 to nkf-1 do begin - out_integer(npf[f_array]); - end; -end - -@ @<Constants...@>= -@!ivalue_arrays=arrays_per_kind; -@!ivalue_entries=entries_per_array; - -@ @<Types...@>= -ivalue_array_type=0..ivalue_arrays; -ivalue_entry_type=0..ivalue_entries; -ivalue_node= -record - in_val: integer; -end; - -@ @<Global...@>= -@!ivalues:array[ivalue_array_type,ivalue_entry_type] of ivalue_node; -@!npi:array[ivalue_array_type] of integer; -@!font_i_array:boolean; -@!nki:integer; -@!nkci:integer; -@!nwi:integer; -@!i_array:integer; -@!i_number:integer; - -@ @<Set init...@>= -for i_array := 0 to ivalue_arrays do begin - npi[i_array]:=0; - @<Null out the ivalue@>; - end; -nki:=-1; -nkci:=-1; - -@ @<Read font ivalue list@>= -begin -if tables_read then - flush_error('All parameter tables must appear before character info'); -i_array:=get_integer; -if i_array>ivalue_arrays then - flush_error('This FONTIVALUE table index is too big for my present size') -else if i_array<0 then - flush_error('This FONTIVALUE index is negative') -else begin - if i_array>nki then nki:=i_array; - while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read an ivalue@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; - finish_inner_property_list; - end; -end - -@ @<Read an ivalue@>= -begin -get_name; -if cur_code=comment_code then skip_to_end_of_item -else if cur_code<>ivalue_code then - flush_error('This property name doesn''t belong in an IVALUE list') -else begin - i_number:=get_integer; - if i_number>ivalue_entries then - flush_error('This IVALUE index is too big for my present table size') - else if i_number<0 then - flush_error('This IVALUE index is negative') - else begin - while npi[i_array]<i_number do begin - incr(npi[i_array]); @<Null out the ivalue@>; - end; - @<Read all of an ivalue's values@>; - finish_the_property; - end; - end; -end - -@ @<Null out the ivalue@>= -begin -ivalues[i_array,npi[i_array]].in_val:=0; -end - -@ @<Read all of an ivalue's values@>= -begin -while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a single ivalue value@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a single ivalue value@>= -begin -get_name; -case cur_code of - ivalue_val_code: - ivalues[i_array,i_number].in_val:=get_integer; - end; -finish_the_property; -end - -@ @<Header information for ivalues@>= -begin -nwi:=0; -for i_array := 0 to nki do begin - incr(npi[i_array]); - nwi := nwi + npi[i_array]; - end; -incr(nki); -end - -@ @<Output the ivalues@>= -begin -for i_array:= 0 to nki-1 do - for i_number:=0 to npi[i_array]-1 do begin - out_integer(ivalues[i_array,i_number].in_val); - end; -end - -@ @<Output the ivalue headers@>= -begin -for i_array:= 0 to nki-1 do begin - out_integer(npi[i_array]); - end; -end - -@ @<Compute the new header information for OFM files@>= -begin -@<Header information for ivalues@>; -@<Header information for fvalues@>; -@<Header information for mvalues@>; -@<Header information for rules@>; -@<Header information for glues@>; -@<Header information for penalties@>; -end - -@ @<Output the new information for OFM files@>= -begin -@<Output the ivalue headers@>; -@<Output the fvalue headers@>; -@<Output the mvalue headers@>; -@<Output the rule headers@>; -@<Output the glue headers@>; -@<Output the penalty headers@>; -@<Output the ivalues@>; -@<Output the fvalues@>; -@<Output the rules@>; -@<Output the glues@>; -@<Output the penalties@>; -end - -@* System-dependent changes. -This section should be replaced, if necessary, by changes to the program -that are necessary to make \.{PLtoTF} 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 printed 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@> - -@* Index. -Pointers to error messages appear here together with the section numbers -where each ident\-i\-fier is used. diff --git a/Build/source/texk/web2c/omegaware/ovf2ovp.ch b/Build/source/texk/web2c/omegaware/ovf2ovp.ch deleted file mode 100644 index 167509717ac..00000000000 --- a/Build/source/texk/web2c/omegaware/ovf2ovp.ch +++ /dev/null @@ -1,610 +0,0 @@ -% -% This file is part of the Omega project, which -% is based in the web2c distribution of TeX. -% -% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous -% applies only to the changes to the original vftovp.ch. -% -% vftovp.ch for C compilation with web2c. -% Written by kb@cs.umb.edu. -% This file is in the public domain. - -@x [0] WEAVE: print changes only. -\pageno=\contentspagenumber \advance\pageno by 1 -@y -\pageno=\contentspagenumber \advance\pageno by 1 -%\let\maybe=\iffalse -%\def\title{VF$\,$\lowercase{to}$\,$VP changes for C} -@z - -@x still [2] Set up for path reading. -procedure initialize; {this procedure gets things started properly} - var @!k:integer; {all-purpose index for initialization} - begin print_ln(banner);@/ -@y -@<Define |parse_arguments|@> -procedure initialize; {this procedure gets things started properly} - var @!k:integer; {all-purpose index for initialization} - begin - kpse_set_progname (argv[0]); - kpse_init_prog ('VFTOVP', 0, nil, nil); - parse_arguments; -@z - -% [4] No name_length. -% Also, AIX defines `class' in <math.h>, so let's take this opportunity to -% define that away. -@x -@<Constants...@>= -@y -@d class == class_var -@<Constants...@>= -@z - -@x -@!name_length=50; {a file name shouldn't be longer than this} -@y -@z - -@x [11] Open the files. -@ On some systems you may have to do something special to read a -packed file of bytes. For example, the following code didn't work -when it was first tried at Stanford, because packed files have to be -opened with a special switch setting on the \PASCAL\ that was used. -@^system dependencies@> - -@<Set init...@>= -reset(tfm_file); reset(vf_file); -@y -@ We don't have to do anything special to read a packed file of bytes, -but we do want to use environment variables to find the input files. -@^system dependencies@> - -@<Set init...@>= -{See comments at |kpse_find_vf| in \.{kpathsea/tex-file.h} for why we - don't use it.} -vf_file := kpse_open_file (vf_name, kpse_ovf_format); -tfm_file := kpse_open_file (tfm_name, kpse_ofm_format); - -if verbose then begin - print (banner); - print_ln (version_string); -end; -@z - -@x [21] Open VPL file. -@!vpl_file:text; - -@ @<Set init...@>= -rewrite(vpl_file); -@y -@!vpl_file:text; - -@ If an explicit filename isn't given, we write to |stdout|. - -@<Set init...@>= -if optind + 3 > argc then begin - vpl_file := stdout; -end else begin - vpl_name := extend_filename (cmdline (optind + 2), 'ovp'); - rewrite (vpl_file, vpl_name); -end; -@z - -% [24] `index' is not a good choice of identifier in C. -@x -@<Types...@>= -@!index=0..tfm_size; {address of a byte in |tfm|} -@y -@d index == index_type - -@<Types...@>= -@!index=0..tfm_size; {address of a byte in |tfm|} -@z - -% [24] abort() should cause a bad exit code. -@x -@d abort(#)==begin print_ln(#); - print_ln('Sorry, but I can''t go on; are you sure this is a OFM?'); - goto final_end; - end -@y -@d abort(#)==begin print_ln(#); - write_ln(stderr, 'Sorry, but I can''t go on; are you sure this is a OFM?'); - uexit(1); - end -@z - -% [31] Ditto for vf_abort. -@x -@d vf_abort(#)==begin - print_ln(#); - print_ln('Sorry, but I can''t go on; are you sure this is a OVF?'); - goto final_end; - end -@y -@d vf_abort(#)==begin - write_ln(stderr, #); - write_ln(stderr, 'Sorry, but I can''t go on; are you sure this is a OVF?'); - uexit(1); - end -@z - -@x [32] Be quiet if not -verbose. -for k:=0 to vf_ptr-1 do print(xchr[vf[k]]); -print_ln(' '); reg_count:=0; -@y -if verbose then begin - for k:=0 to vf_ptr-1 do print(xchr[vf[k]]); - print_ln(' '); -end; -reg_count:=0; -@z - -@x [35] Be quiet if not -verbose. -@<Print the name of the local font@>; -@y -if verbose then begin - @<Print the name of the local font@>; -end; -@z - -@x [36] Output of real numbers. -print_ln(' at ',(((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize:2:2, - 'pt') -@y -print(' at '); -print_real((((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize, 2, 2); -print_ln('pt') -@z - -@x [37] No arbitrary max on cur_name. -@!cur_name:packed array[1..name_length] of char; {external name, - with no lower case letters} -@y -@!cur_name:^char; {external tfm name} -@z - -@x [39] Open another TFM file. -reset(tfm_file,cur_name); -@^system dependencies@> -if eof(tfm_file) then - print_ln('---not loaded, font metric file can''t be opened!') -@.font metric file can\'t be opened@> -else begin font_bc:=0; font_ec:=65536; {will cause error if not modified soon} -@y -tfm_file := kpse_open_file (cur_name, kpse_ofm_format); -@^system dependencies@> -if eof(tfm_file) then - print_ln('---not loaded, font metric file can''t be opened!') -@.font metric file can\'t be opened@> -else begin font_bc:=0; font_ec:=65536; {will cause error if not modified soon} -@z - -@x [40] Be quiet if not -verbose. - print_ln('Check sum in OVF file being replaced by font metric check sum'); -@y - if verbose then - print_ln('Check sum in OVF file being replaced by font metric check sum'); -@z - -@x [42] Remove initialization of now-defunct array. -@ @<Set init...@>= -default_directory:=default_directory_name; -@y -@ (No initialization to be done. Keep this module to preserve numbering.) -@z - -@x [44] Don't append `.tfm' here, and keep lowercase. -for k:=1 to name_length do cur_name[k]:=' '; -if a=0 then begin - for k:=1 to default_directory_name_length do - cur_name[k]:=default_directory[k]; - r:=default_directory_name_length; - end -else r:=0; -for k:=font_start[font_ptr]+14 to vf_ptr-1 do begin - incr(r); - if r+4>name_length then vf_abort('Font name too long for me!'); -@.Font name too long for me@> - if (vf[k]>="a")and(vf[k]<="z") then - cur_name[r]:=xchr[vf[k]-@'40] - else cur_name[r]:=xchr[vf[k]]; - end; -cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M' -@y -@ The string |cur_name| is supposed to be set to the external name of the -\.{TFM} file for the current font. We do not impose an arbitrary limit -on the filename length. -@^system dependencies@> - -@d name_start == (font_start[font_ptr] + 14) -@d name_end == vf_ptr - -@<Move font name into the |cur_name| string@>= -r := name_end - name_start; -cur_name := xmalloc (r + 1); -{|strncpy| might be faster, but it's probably a good idea to keep the - |xchr| translation.} -for k := name_start to name_end do begin - cur_name[k - name_start] := xchr[vf[k]]; -end; -cur_name[r] := 0; {Append null byte since this is C.} -@z - -@x [49] Change strings to C char pointers, so we can initialize them. -@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char; - {strings for output in the user's external character set} -@!xchr:packed array [0..255] of char; -@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char; - {handy string constants for |face| codes} -@y -@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: c_string; - {strings for output in the user's external character set} -@!ASCII_all: packed array[0..256] of char; -@!xchr:packed array [0..255] of char; -@!MBL_string,@!RI_string,@!RCE_string: c_string; - {handy string constants for |face| codes} -@z - -@x [50] The Pascal strings are indexed starting at 1, so we pad with a blank. -ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ -ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ -ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~?';@/ -HEX:='0123456789ABCDEF';@/ -@y -ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ -ASCII_10:=' @@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ -ASCII_14:=' `abcdefghijklmnopqrstuvwxyz{|}~?';@/ -HEX:=' 0123456789ABCDEF';@/ -strcpy (ASCII_all, ASCII_04); -strcat (ASCII_all, '@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'); -strcat (ASCII_all, '`abcdefghijklmnopqrstuvwxyz{|}~');@/ -@z - -@x -MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE'; -@y -MBL_string:=' MBL'; RI_string:=' RI '; RCE_string:=' RCE'; -@z - -% [60] How we output the character code depends on |charcode_format|. -@x -begin if font_type>vanilla then - out_hex_char(c) -else if (c>="0")and(c<="9") then - out(' C ',c-"0":1) -else if (c>="A")and(c<="Z") then - out(' C ',ASCII_10[c-"A"+2]) -else if (c>="a")and(c<="z") then - out(' C ',ASCII_14[c-"a"+2]) -else out_hex_char(c); -end; -@y -begin if (font_type > vanilla) or (charcode_format = charcode_hex) then - out_hex_char(c) -else if (charcode_format = charcode_ascii) and (c > " ") and (c <= "~") - and (c <> "(") and (c <> ")") then - out(' C ', ASCII_all[c - " " + 1]) -{default case, use hex} -else out_hex_char(c); -end; -@z - -% [61] Don't output the face code as an integer. -@x - out(MBL_string[1+(b mod 3)]); - out(RI_string[1+s]); - out(RCE_string[1+(b div 3)]); -@y - put_byte(MBL_string[1+(b mod 3)], vpl_file); - put_byte(RI_string[1+s], vpl_file); - put_byte(RCE_string[1+(b div 3)], vpl_file); -@z - -@x [62] Force 32-bit constant arithmetic for 16-bit machines. -f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3]; -@y -f:=((tfm[k+1] mod 16)*intcast(@'400)+tfm[k+2])*@'400+tfm[k+3]; -@z - -% [100] No progress reports unless verbose. -@x - incr(chars_on_line); - end; - for cprime:=c to (c+no_repeats(c)) do begin - print_hex(cprime); {progress report} -@y - if verbose then incr(chars_on_line); - end; - for cprime:=c to (c+no_repeats(c)) do begin - if verbose then print_hex(cprime); {progress report} -@z - -% [112] No nonlocal goto's. -@x - print_ln('Sorry, I haven''t room for so many ligature/kern pairs!'); -@.Sorry, I haven't room...@> - goto final_end; -@y - write_ln(stderr, 'Sorry, I haven''t room for so many ligature/kern pairs!'); -@.Sorry, I haven't room...@> - uexit(1); -@z - -% still [112] We can't have a function named `f', because of the local -% variable in do_simple_things. It would be better, but harder, to fix -% web2c. -@x - r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char); -@y - r:=lig_f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char); -@z - -@x - out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end; -@y - out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); uexit(1); -@z - -% [116] web2c can't handle these mutually recursive procedures. -% But let's do a fake definition of f here, so that it gets into web2c's -% symbol table... -@x -@p function f(@!h,@!x,@!y:index):index; forward;@t\2@> - {compute $f$ for arguments known to be in |hash[h]|} -@y -@p -ifdef('notdef') -function lig_f(@!h,@!x,@!y:index):index; begin end;@t\2@> - {compute $f$ for arguments known to be in |hash[h]|} -endif('notdef') -@z - -@x -else eval:=f(h,x,y); -@y -else eval:=lig_f(h,x,y); -@z - -@x [117] ... and then really define it now. -@p function f; -@y -@p function lig_f(@!h,@!x,@!y:index):index; -@z - -@x -f:=lig_z[h]; -@y -lig_f:=lig_z[h]; -@z - -@x [124] Some cc's can't handle 136 case labels. - o:=vf[vf_ptr]; incr(vf_ptr); - case o of - @<Cases of \.{DVI} instructions that can appear in character packets@>@; -@y - o:=vf[vf_ptr]; incr(vf_ptr); - if ((o<=set_char_0+127))or - ((o>=set1)and(o<=set1+3))or((o>=put1)and(o<=put1+3)) then -begin if o>=set1 then - if o>=put1 then c:=get_bytes(o-put1+1,false) - else c:=get_bytes(o-set1+1,false) - else c:=o; - if f=font_ptr then - bad_vf('Character ',c:1,' in undeclared font will be ignored') -@.Character...will be ignored@> - else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left} - k:=font_chars[f];@+while vf[k]<>c do incr(k); - if k=font_start[f+1]-1 then - bad_vf('Character ',c:1,' in font ',f:1,' will be ignored') - else begin if o>=put1 then out('(PUSH)'); - left; out('SETCHAR'); out_char(c); - if o>=put1 then out(')(POP'); - right; - end; - end; - end - else case o of - @<Cases of \.{DVI} instructions that can appear in character packets@> -@z - -@x [125] `signed' is a reserved word in ANSI C. -@p function get_bytes(@!k:integer;@!signed:boolean):integer; -@y -@d signed == is_signed {|signed| is a reserved word in ANSI C} -@p function get_bytes(@!k:integer;@!signed:boolean):integer; -@z - -@x [126] No nonlocal goto's. - begin print_ln('Stack overflow!'); goto final_end; -@y - begin write_ln(stderr, 'Stack overflow!'); uexit(1); -@z - -@x [129] This code moved outside the case statement -@ Before we typeset a character we make sure that it exists. - -@<Cases...@>= -sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64), - four_cases(set1),four_cases(put1):begin if o>=set1 then - if o>=put1 then c:=get_bytes(o-put1+1,false) - else c:=get_bytes(o-set1+1,false) - else c:=o; - if f=font_ptr then - bad_vf('Character ',c:1,' in undeclared font will be ignored') -@.Character...will be ignored@> - else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left} - k:=font_chars[f];@+while vf[k]<>c do incr(k); - if k=font_start[f+1]-1 then - bad_vf('Character ',c:1,' in font ',f:1,' will be ignored') - else begin if o>=put1 then out('(PUSH)'); - left; out('SETCHAR'); out_char(c); - if o>=put1 then out(')(POP'); - right; - end; - end; - end; -@y -@ Before we typeset a character we make sure that it exists. -(These cases moved outside the case statement, section 124.) -@z - -@x [134] No final newline unless verbose. -print_ln('.');@/ -@y -if verbose then print_ln('.');@/ -@z - -@x [135] System-dependent changes. -This section should be replaced, if necessary, by changes to the program -that are necessary to make \.{VFtoVP} 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 printed 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@> -@y -Parse a Unix-style command line. - -@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0) - -@<Define |parse_arguments|@> = -procedure parse_arguments; -const n_options = 4; {Pascal won't count array lengths for us.} -var @!long_options: array[0..n_options] of getopt_struct; - @!getopt_return_val: integer; - @!option_index: c_int_type; - @!current_option: 0..n_options; -begin - @<Initialize the option variables@>; - @<Define the option table@>; - repeat - getopt_return_val := getopt_long_only (argc, argv, '', long_options, - address_of (option_index)); - if getopt_return_val = -1 then begin - {End of arguments; we exit the loop below.} ; - end else if getopt_return_val = "?" then begin - usage ('ovf2ovp'); - - end else if argument_is ('help') then begin - usage_help (OVF2OVP_HELP, nil); - - end else if argument_is ('version') then begin - print_version_and_exit - (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth', nil); - - end else if argument_is ('charcode-format') then begin - if strcmp (optarg, 'ascii') = 0 then - charcode_format := charcode_ascii - else if strcmp (optarg, 'hex') = 0 then - charcode_format := charcode_hex - else - write_ln (stderr, 'Bad character code format', optarg, '.'); - - end; {Else it was a flag; |getopt| has already done the assignment.} - until getopt_return_val = -1; - - {Now |optind| is the index of first non-option on the command line. - We must have one two three remaining arguments.} - if (optind + 1 <> argc) and (optind + 2 <> argc) - and (optind + 3 <> argc) then begin - write_ln (stderr, 'ovf2ovp: Need one to three file arguments.'); - usage ('ovf2ovp'); - end; - - vf_name := cmdline (optind); - if optind + 2 <= argc then begin - tfm_name := cmdline (optind + 1); {The user specified the TFM name.} - end else begin - {User did not specify TFM name; default it from the VF name.} - tfm_name := basename_change_suffix (vf_name, '.ovf', '.ofm'); - end; -end; - -@ Here are the options we allow. The first is one of the standard GNU options. -@.-help@> - -@<Define the option...@> = -current_option := 0; -long_options[current_option].name := 'help'; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; -incr (current_option); - -@ Another of the standard options. -@.-version@> - -@<Define the option...@> = -long_options[current_option].name := 'version'; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; -incr (current_option); - -@ Print progress information? -@.-verbose@> - -@<Define the option...@> = -long_options[current_option].name := 'verbose'; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := address_of (verbose); -long_options[current_option].val := 1; -incr (current_option); - -@ The global variable |verbose| determines whether or not we print -progress information. - -@<Glob...@> = -@!verbose: c_int_type; - -@ It starts off |false|. - -@<Initialize the option...@> = -verbose := false; - -@ Here is an option to change how we output character codes. -@.-charcode-format@> - -@<Define the option...@> = -long_options[current_option].name := 'charcode-format'; -long_options[current_option].has_arg := 1; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; -incr (current_option); - -@ We use an ``enumerated'' type to store the information. - -@<Type...@> = -@!charcode_format_type = charcode_ascii..charcode_default; - -@ -@<Const...@> = -@!charcode_ascii = 0; -@!charcode_hex = 1; -@!charcode_default = 2; - -@ -@<Global...@> = -@!charcode_format: charcode_format_type; - -@ It starts off as the default, which is hex for OFM2OPL. - -@<Initialize the option...@> = -charcode_format := charcode_default; - -@ An element with all zeros always ends the list. - -@<Define the option...@> = -long_options[current_option].name := 0; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; - -@ Global filenames. - -@<Global...@> = -@!vf_name, @!tfm_name, @!vpl_name:c_string; -@z diff --git a/Build/source/texk/web2c/omegaware/ovf2ovp.web b/Build/source/texk/web2c/omegaware/ovf2ovp.web deleted file mode 100644 index 2e2e374dca5..00000000000 --- a/Build/source/texk/web2c/omegaware/ovf2ovp.web +++ /dev/null @@ -1,3138 +0,0 @@ -% -% This file is part of the Omega project, which -% is based in the web2c distribution of TeX. -% -% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous -% applies only to the changes to the original vftovp.web. -% -% This program by D. E. Knuth is not copyrighted and can be used freely. -% Version 1 was implemented in December 1989. -% Version 1.1 fixed problems of strict Pascal (April 1990). -% Version 1.2 fixed various bugs found by Peter Breitenlohner (September 1990). - -% Here is TeX material that gets inserted after \input webmac -\def\hang{\hangindent 3em\indent\ignorespaces} -\font\ninerm=cmr9 -\let\mc=\ninerm % medium caps for names like SAIL -\def\PASCAL{Pascal} - -\def\(#1){} % this is used to make section names sort themselves better -\def\9#1{} % this is used for sort keys in the index - -\def\title{OVF2OVP} -\def\contentspagenumber{101} -\def\topofcontents{\null - \def\titlepage{F} % include headline on the contents page - \def\rheader{\mainfont\hfil \contentspagenumber} - \vfill - \centerline{\titlefont The {\ttitlefont OVF2OVP} processor} - \vskip 15pt - \centerline{(Version 1.11, February 2000)} - \vfill} -\def\botofcontents{\vfill - \centerline{\hsize 5in\baselineskip9pt - \vbox{\ninerm\noindent - The preparation of this program - was supported in part by the National Science - Foundation and by the System Development Foundation. `\TeX' is a - trademark of the American Mathematical Society.}}} -\pageno=\contentspagenumber \advance\pageno by 1 - -@* Introduction. -The \.{VFtoVP} utility program converts a virtual font (``\.{VF}'') file -and its associated \TeX\ font metric (``\.{TFM}'') -file into an equivalent virtual-property-list (``\.{VPL}'') file. It also -makes a thorough check of the given files, using algorithms that are -essentially the same as those used by -\.{DVI} device drivers and by \TeX. Thus if \TeX\ or a \.{DVI} driver -complains that a \.{TFM} or \.{VF} -file is ``bad,'' this program will pinpoint the source or sources of -badness. A \.{VPL} file output by this program can be edited with -a normal text editor, and the result can be converted back to \.{VF} and \.{TFM} -format using the companion program \.{VPtoVF}. - -\indent\.{VFtoVP} is an extended version of the program \.{TFtoPL}, which -is part of the standard \TeX ware library. -The idea of a virtual font was inspired by the work of David R. Fuchs -@^Fuchs, David Raymond@> -who designed a similar set of conventions in 1984 while developing a -device driver for ArborText, Inc. He wrote a somewhat similar program -called \.{AMFtoXPL}. - -The |banner| string defined here should be changed whenever \.{VFtoVP} -gets modified. - -@d banner=='This is OVF2OVP, Version 1.11' {printed when the program starts} - -@ This program is written entirely in standard \PASCAL, except that -it occasionally has lower case letters in strings that are output. -Such letters can be converted to upper case if necessary. The input is read -from |vf_file| and |tfm_file|; the output is written on |vpl_file|. -Error messages and -other remarks are written on the |output| file, which the user may -choose to assign to the terminal if the system permits it. -@^system dependencies@> - -The term |print| is used instead of |write| when this program writes on -the |output| file, so that all such output can be easily deflected. - -@d print(#)==write(#) -@d print_ln(#)==write_ln(#) - -@p program OVF2OVP(@!vf_file,@!tfm_file,@!vpl_file,@!output); -label @<Labels in the outer block@>@/ -const @<Constants in the outer block@>@/ -type @<Types in the outer block@>@/ -var @<Globals in the outer block@>@/ -procedure initialize; {this procedure gets things started properly} - var @!k:integer; {all-purpose index for initialization} - begin print_ln(banner);@/ - @<Set initial values@>@/ - end; - -@ If the program has to stop prematurely, it goes to the -`|final_end|'. - -@d final_end=9999 {label for the end of it all} - -@<Labels...@>=final_end; - -@ The following parameters can be changed at compile time to extend or -reduce \.{VFtoVP}'s capacity. - -@<Constants...@>= -@!tfm_size=2000000; {maximum length of |tfm| data, in bytes} -@!vf_size=600000; {maximum length of |vf| data, in bytes} -@!max_fonts=300; {maximum number of local fonts in the |vf| file} -@!lig_size=800000; {maximum length of |lig_kern| program, in words} -@!hash_size=130003; {preferably a prime number, a bit larger than the number - of character pairs in lig/kern steps} -@!hash_mult=16007; {another prime} -@!max_char=65535; {the largest character number in a font} -@!xmax_char=65536; {|max_char|+1} -@!xxmax_char=65537;{|max_char|+2} -@!xmax_label=80001;{must be greater than |max_lig_steps|} -@!mem_size=40008; {|max_char|*4+8} -@!name_length=50; {a file name shouldn't be longer than this} -@!max_stack=50; {maximum depth of \.{DVI} stack in character packets} - -@ Here are some macros for common programming idioms. - -@d incr(#) == #:=#+1 {increase a variable by unity} -@d decr(#) == #:=#-1 {decrease a variable by unity} -@d do_nothing == {empty statement} -@d exit=10 {go here to leave a procedure} -@d not_found=45 {go here when you've found nothing} -@d return==goto exit {terminate a procedure call} -@f return==nil - -@<Types...@>= -@!byte=0..255; {unsigned eight-bit quantity} - -@* Virtual fonts. The idea behind \.{VF} files is that a general -interface mechanism is needed to switch between the myriad font -layouts provided by different suppliers of typesetting equipment. -Without such a mechanism, people must go to great lengths writing -inscrutable macros whenever they want to use typesetting conventions -based on one font layout in connection with actual fonts that have -another layout. This puts an extra burden on the typesetting system, -interfering with the other things it needs to do (like kerning, -hyphenation, and ligature formation). - -These difficulties go away when we have a ``virtual font,'' -i.e., a font that exists in a logical sense but not a physical sense. -A typesetting system like \TeX\ can do its job without knowing where the -actual characters come from; a device driver can then do its job by -letting a \.{VF} file tell what actual characters correspond to the -characters \TeX\ imagined were present. The actual characters -can be shifted and/or magnified and/or combined with other characters -from many different fonts. A virtual font can even make use of characters -from virtual fonts, including itself. - -Virtual fonts also allow convenient character substitutions for proofreading -purposes, when fonts designed for one output device are unavailable on another. - -@ A \.{VF} file is organized as a stream of 8-bit bytes, using conventions -borrowed from \.{DVI} and \.{PK} files. Thus, a device driver that knows -about \.{DVI} and \.{PK} format will already -contain most of the mechanisms necessary to process \.{VF} files. -We shall assume that \.{DVI} format is understood; the conventions in the -\.{DVI} documentation (see, for example, {\sl \TeX: The Program}, part 31) -are adopted here to define \.{VF} format. - -A preamble -appears at the beginning, followed by a sequence of character definitions, -followed by a postamble. More precisely, the first byte of every \.{VF} file -must be the first byte of the following ``preamble command'': - -\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]| |cs[4]| |ds[4]|. -Here |i| is the identification byte of \.{VF}, currently 202. The string -|x| is merely a comment, usually indicating the source of the \.{VF} file. -Parameters |cs| and |ds| are respectively the check sum and the design size -of the virtual font; they should match the first two words in the header of -the \.{TFM} file, as described below. - -\yskip -After the |pre| command, the preamble continues with font definitions; -every font needed to specify ``actual'' characters in later -\\{set\_char} commands is defined here. The font definitions are -exactly the same in \.{VF} files as they are in \.{DVI} files, except -that the scaled size |s| is relative and the design size |d| is absolute: - -\yskip\hang|fnt_def1| 243 |k[1]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|. -Define font |k|, where |0<=k<256|. - -\yskip\hang|@!fnt_def2| 244 |k[2]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|. -Define font |k|, where |0<=k<65536|. - -\yskip\hang|@!fnt_def3| 245 |k[3]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|. -Define font |k|, where |0<=k<@t$2^{24}$@>|. - -\yskip\hang|@!fnt_def4| 246 |k[4]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|. -Define font |k|, where |@t$-2^{31}$@><=k<@t$2^{31}$@>|. - -\yskip\noindent -These font numbers |k| are ``local''; they have no relation to font numbers -defined in the \.{DVI} file that uses this virtual font. The dimension~|s|, -which represents the scaled size of the local font being defined, -is a |fix_word| relative to the design size of the virtual font. -Thus if the local font is to be used at the same size -as the design size of the virtual font itself, |s| will be the -integer value $2^{20}$. The value of |s| must be positive and less than -$2^{24}$ (thus less than 16 when considered as a |fix_word|). -The dimension~|d| is a |fix_word| in units of printer's points; hence it -is identical to the design size found in the corresponding \.{TFM} file. - -@d id_byte=202 - -@<Glob...@>= -@!vf_file:packed file of byte; - -@ The preamble is followed by zero or more character packets, where each -character packet begins with a byte that is $<243$. Character packets have -two formats, one long and one short: - -\yskip\hang|long_char| 242 |pl[4]| |cc[4]| |tfm[4]| |dvi[pl]|. This long form -specifies a virtual character in the general case. - -\yskip\hang|short_char0..short_char241| -|pl[1]| |cc[1]| |tfm[3]| |dvi[pl]|. This short form specifies a -virtual character in the common case -when |0<=pl<242| and |0<=cc<256| and $0\le|tfm|<2^{24}$. - -\yskip\noindent -Here |pl| denotes the packet length following the |tfm| value; |cc| is -the character code; and |tfm| is the character width copied from the -\.{TFM} file for this virtual font. There should be at most one character -packet having any given |cc| code. - -The |dvi| bytes are a sequence of complete \.{DVI} commands, properly -nested with respect to |push| and |pop|. All \.{DVI} operations are -permitted except |bop|, |eop|, and commands with opcodes |>=243|. -Font selection commands (|fnt_num0| through |fnt4|) must refer to fonts -defined in the preamble. - -Dimensions that appear in the \.{DVI} instructions are analogous to -|fix_word| quantities; i.e., they are integer multiples of $2^{-20}$ times -the design size of the virtual font. For example, if the virtual font -has design size $10\,$pt, the \.{DVI} command to move down $5\,$pt -would be a \\{down} instruction with parameter $2^{19}$. The virtual font -itself might be used at a different size, say $12\,$pt; then that -\\{down} instruction would move down $6\,$pt instead. Each dimension -must be less than $2^{24}$ in absolute value. - -Device drivers processing \.{VF} files treat the sequences of |dvi| bytes -as subroutines or macros, implicitly enclosing them with |push| and |pop|. -Each subroutine begins with |w=x=y=z=0|, and with current font~|f| the -number of the first-defined in the preamble (undefined if there's no -such font). After the |dvi| commands have been -performed, the |h| and~|v| position registers of \.{DVI} format and the -current font~|f| are restored to their former values; -then, if the subroutine has been invoked by a \\{set\_char} or \\{set} -command, |h|~is increased by the \.{TFM} width -(properly scaled)---just as if a simple character had been typeset. - -@d long_char=242 {\.{VF} command for general character packet} -@d set_char_0=0 {\.{DVI} command to typeset character 0 and move right} -@d set1=128 {typeset a character and move right} -@d set_rule=132 {typeset a rule and move right} -@d put1=133 {typeset a character} -@d put_rule=137 {typeset a rule} -@d nop=138 {no operation} -@d push=141 {save the current positions} -@d pop=142 {restore previous positions} -@d right1=143 {move right} -@d w0=147 {move right by |w|} -@d w1=148 {move right and set |w|} -@d x0=152 {move right by |x|} -@d x1=153 {move right and set |x|} -@d down1=157 {move down} -@d y0=161 {move down by |y|} -@d y1=162 {move down and set |y|} -@d z0=166 {move down by |z|} -@d z1=167 {move down and set |z|} -@d fnt_num_0=171 {set current font to 0} -@d fnt1=235 {set current font} -@d xxx1=239 {extension to \.{DVI} primitives} -@d xxx4=242 {potentially long extension to \.{DVI} primitives} -@d fnt_def1=243 {define the meaning of a font number} -@d pre=247 {preamble} -@d post=248 {postamble beginning} -@d improper_DVI_for_VF==139,140,243,244,245,246,247,248,249,250,251,252, - 253,254,255 - -@ The character packets are followed by a trivial postamble, consisting of -one or more bytes all equal to |post| (248). The total number of bytes -in the file should be a multiple of~4. - -@* Font metric data. -The idea behind \.{TFM} files is that typesetting routines like \TeX\ -need a compact way to store the relevant information about several -dozen fonts, and computer centers need a compact way to store the -relevant information about several hundred fonts. \.{TFM} files are -compact, and most of the information they contain is highly relevant, -so they provide a solution to the problem. - -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 \TeX\ uses the -byte interpretation, and so does \.{VFtoVP}. Note that the bytes -are considered to be unsigned numbers. - -@<Glob...@>= -@!tfm_file:packed file of byte; - -@ On some systems you may have to do something special to read a -packed file of bytes. For example, the following code didn't work -when it was first tried at Stanford, because packed files have to be -opened with a special switch setting on the \PASCAL\ that was used. -@^system dependencies@> - -@<Set init...@>= -reset(tfm_file); reset(vf_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. - -@<Glob...@>= -@!ofm_level, -@!nco,@!ncw,@!npc,@!nki,@!nwi,@!nkf,@!nwf,@!nkr,@!nwr,@!nkg,@!nwg,@!nkp,@!nwp, -@!nkm,@!nwm,@!real_lf, -@!lf,@!lh,@!bc,@!ec,@!nw,@!nh,@!nd,@!ni,@!nl,@!nk,@!ne,@!np,@!font_dir:integer; - {subfile sizes} -@!ofm_on:boolean; - -@ @<Set init...@>= -ofm_on:=false; ofm_level:=-1; lf:=0; lh:=0; -nco:=0; ncw:=0; npc:=0; bc:=0; ec:=0; nw:=0; nh:=0; nd:=0; ni:=0; -nl:=0; nk:=0; ne:=0; np:=0; -nki:=0; nwi:=0; nkf:=0; nwf:=0; -nkm:=0; nwm:=0; real_lf:=0; -nkr:=0; nwr:=0; nkg:=0; nwg:=0; -nkp:=0; nwp:=0; font_dir:=0; - -@ The rest of the \.{TFM} file may be regarded as a sequence of ten data -arrays having the informal specification -$$\def\arr$[#1]#2${\&{array} $[#1]$ \&{of} #2} -\vbox{\halign{\hfil\\{#}&$\,:\,$\arr#\hfil\cr -header&|[0..lh-1]stuff|\cr -char\_info&|[bc..ec]char_info_word|\cr -width&|[0..nw-1]fix_word|\cr -height&|[0..nh-1]fix_word|\cr -depth&|[0..nd-1]fix_word|\cr -italic&|[0..ni-1]fix_word|\cr -lig\_kern&|[0..nl-1]lig_kern_command|\cr -kern&|[0..nk-1]fix_word|\cr -exten&|[0..ne-1]extensible_recipe|\cr -param&|[1..np]fix_word|\cr}}$$ -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 one of -the |fix_word| values will 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, -and for \.{TFM} files to be used with Xerox printing software it must -contain at least 18 words, allocated as described below. When different -kinds of devices need to be interfaced, it may be necessary to add further -words to the header block. - -\yskip\hang|header[0]| is a 32-bit check sum that \TeX\ will copy into the -\.{DVI} output file whenever it uses the font. Later on when the \.{DVI} -file is printed, possibly on another computer, the actual font that gets -used is supposed to have a check sum that agrees with the one in the -\.{TFM} file used by \TeX. In this way, users will be warned about -potential incompatibilities. (However, if the check sum is zero in either -the font file or the \.{TFM} file, no check is made.) 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 (7227 \TeX\ points = 254 cm). 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]|, one \.{em} or \.{\\quad}, 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@> - -\yskip\hang|header[2..11]|, if present, contains 40 bytes that identify -the character coding scheme. The first byte, which must be between 0 and -39, is the number of subsequent ASCII bytes actually relevant in this -string, which is intended to specify what character-code-to-symbol -convention is present in the font. Examples are \.{ASCII} for standard -ASCII, \.{TeX text} for fonts like \.{cmr10} and \.{cmti9}, \.{TeX math -extension} for \.{cmex10}, \.{XEROX text} for Xerox fonts, \.{GRAPHIC} for -special-purpose non-alphabetic fonts, \.{UNSPECIFIED} for the default case -when there is no information. Parentheses should not appear in this name. -(Such a string is said to be in {\mc BCPL} format.) -@^coding scheme@> - -\yskip\hang|header[12..16]|, if present, contains 20 bytes that name the -font family (e.g., \.{CMR} or \.{HELVETICA}), in {\mc BCPL} format. -This field is also known as the ``font identifier.'' -@^family name@> -@^font identifier@> - -\yskip\hang|header[17]|, if present, contains a first byte called the -|seven_bit_safe_flag|, then two bytes that are ignored, and a fourth byte -called the |face|. If the value of the fourth byte is less than 18, it has -the following interpretation as a ``weight, slope, and expansion'': Add 0 -or 2 or 4 (for medium or bold or light) to 0 or 1 (for roman or italic) to -0 or 6 or 12 (for regular or condensed or extended). For example, 13 is -0+1+12, so it represents medium italic extended. A three-letter code -(e.g., \.{MIE}) can be used for such |face| data. - -\yskip\hang|header[18..@twhatever@>]| might also be present; the individual -words are simply called |header[18]|, |header[19]|, etc., at the moment. - -@ Next comes the |char_info| array, which contains one |char_info_word| -per character. Each |char_info_word| 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 |lig_kern[remainder]|.\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 - -@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 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). - -Notice that if $a=0$ and $b=1$, the current character is unchanged; if -$a=b$ and $c=1$, the current character is changed but the next character is -unchanged. \.{VFtoVP} will check to see that infinite loops are avoided. - -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 have -|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} - -@ 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. - - -@ 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's the only |fix_word| other than the design size itself that is -not scaled by the design size. - -\hang|param[2]=space| is the normal spacing between words in text. -Note that character |" "| 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 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. - -When the character coding scheme is \.{TeX math symbols}, the font is -supposed to have 15 additional parameters called |num1|, |num2|, |num3|, -|denom1|, |denom2|, |sup1|, |sup2|, |sup3|, |sub1|, |sub2|, |supdrop|, -|subdrop|, |delim1|, |delim2|, and |axis_height|, respectively. When the -character coding scheme is \.{TeX math extension}, the font is supposed to -have six additional parameters called |default_rule_thickness| and -|big_op_spacing1| through |big_op_spacing5|. - -@ So that is what \.{TFM} files hold. The next question is, ``What about -\.{VPL} files?'' A complete answer to that question appears in the -documentation of the companion program, \.{VPtoVF}, so it will not -be repeated here. Suffice it to say that a \.{VPL} file is an ordinary -\PASCAL\ text file, and that the output of \.{VFtoVP} uses only a -subset of the possible constructions that might appear in a \.{VPL} file. -Furthermore, hardly anybody really wants to look at the formal -definition of \.{VPL} format, because it is almost self-explanatory when -you see an example or two. - -@<Glob...@>= -@!vpl_file:text; - -@ @<Set init...@>= -rewrite(vpl_file); - -@* Unpacking the TFM file. -The first thing \.{VFtoVP} does is read the entire |tfm_file| into an array of -bytes, |tfm[0..(4*lf-1)]|. - -@<Types...@>= -@!index=0..tfm_size; {address of a byte in |tfm|} -@!char_type=0..65535; -@!xchar_type=0..65536; -@!xxchar_type=0..65537; -@!xxxchar_type=0..65538; - -@ -@<Glob...@>= -@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here} - {the negative addresses avoid range checks for invalid characters} -@!top_char,@!top_width,@!top_height,@!top_depth,@!top_italic:integer; -@!start_ptr,@!check_sum,@!design_size,@!scheme,@!family,@!random_word:integer; -@!header_length,@!char_ptr,@!copies,@!j:integer; - -@ The input may, of course, be all screwed up and not a \.{TFM} file -at all. So we begin cautiously. - -@d abort(#)==begin print_ln(#); - print_ln('Sorry, but I can''t go on; are you sure this is a OFM?'); - goto final_end; - end - -@<Read the whole font metric file@>= -read(tfm_file,tfm[0]); -if tfm[0]>127 then abort('The first byte of the input file exceeds 127!'); -@.The first byte...@> -if eof(tfm_file) then abort('The input file is only one byte long!'); -@.The input...one byte long@> -read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1]; -if lf=0 then begin - for i:=2 to 7 do begin - if eof(tfm_file) - then abort('The input file is too short to designate its length!'); - read(tfm_file, tfm[i]); - end; - ofm_on := true; ofm_level := tfm[2]*@"100+tfm[3]; - if tfm[4]>127 then abort('The fifth byte of the input file exceeds 127!'); - lf := tfm[4]*@"1000000 + tfm[5]*@"10000 + tfm[6]*@"100 + tfm[7]; - end -else begin - ofm_on := false; - end; -case ofm_level of - -1: begin start_ptr:=2; check_sum:=24; end; - 0: begin start_ptr:=8; check_sum:=56; end; - 1: begin start_ptr:=8; check_sum:=116; end; - end; -design_size:=check_sum+4; -scheme:=design_size+4; -family:=scheme+40; -random_word:=family+20; -if lf=0 then - abort('The file claims to have length zero, but that''s impossible!'); -@.The file claims...@> -if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!'); -@.The file is bigger...@> -for tfm_ptr:=start_ptr to 4*lf-1 do begin - if eof(tfm_file) then - abort('The file has fewer bytes than it claims!'); -@.The file has fewer bytes...@> - read(tfm_file,tfm[tfm_ptr]); - end; -if not eof(tfm_file) then begin - print_ln('There''s some extra junk at the end of the OFM file,'); -@.There's some extra junk...@> - print_ln('but I''ll proceed as if it weren''t there.'); - end - -@ After the file has been read successfully, we look at the subfile sizes -to see if they check out. - -@d eval_two_bytes(#)==begin if tfm[tfm_ptr]>127 then - abort('One of the subfile sizes is negative!'); -@.One of the subfile sizes...@> - #:=tfm[tfm_ptr]*@'400+tfm[tfm_ptr+1]; - tfm_ptr:=tfm_ptr+2; - end -@d eval_four_bytes(#)==begin if tfm[tfm_ptr]>127 then - abort('One of the subfile sizes is negative!'); -@.One of the subfile sizes...@> - #:=tfm[tfm_ptr]*@"1000000+tfm[tfm_ptr+1]*@"10000+ - tfm[tfm_ptr+2]*@"100+tfm[tfm_ptr+3]; - tfm_ptr:=tfm_ptr+4; - end - -@<Set subfile sizes |lh|, |bc|, \dots, |np|@>= -begin -if not ofm_on then begin - tfm_ptr:=2; - eval_two_bytes(lh); - eval_two_bytes(bc); - eval_two_bytes(ec); - eval_two_bytes(nw); - eval_two_bytes(nh); - eval_two_bytes(nd); - eval_two_bytes(ni); - eval_two_bytes(nl); - eval_two_bytes(nk); - eval_two_bytes(ne); - eval_two_bytes(np); - ncw:=(ec-bc+1); - header_length:=6; - top_char:=255; - top_width:=255; - top_height:=15; - top_depth:=15; - top_italic:=63; - end -else begin - tfm_ptr:=8; - eval_four_bytes(lh); - eval_four_bytes(bc); - eval_four_bytes(ec); - eval_four_bytes(nw); - eval_four_bytes(nh); - eval_four_bytes(nd); - eval_four_bytes(ni); - eval_four_bytes(nl); - eval_four_bytes(nk); - eval_four_bytes(ne); - eval_four_bytes(np); - eval_four_bytes(font_dir); - top_char:=65535; - top_width:=65535; - top_height:=255; - top_depth:=255; - top_italic:=255; - if ofm_level=0 then begin - header_length:=14; - ncw:=2*(ec-bc+1); - end - else begin - header_length:=29; - eval_four_bytes(nco); - eval_four_bytes(ncw); - eval_four_bytes(npc); - eval_four_bytes(nki); {Kinds of font ivalues} - eval_four_bytes(nwi); {Words of font ivalues} - eval_four_bytes(nkf); {Kinds of font fvalues} - eval_four_bytes(nwf); {Words of font fvalues} - eval_four_bytes(nkm); {Kinds of font mvalues} - eval_four_bytes(nwm); {Words of font mvalues} - eval_four_bytes(nkr); {Kinds of font rules} - eval_four_bytes(nwr); {Words of font rules} - eval_four_bytes(nkg); {Kinds of font glues} - eval_four_bytes(nwg); {Words of font glues} - eval_four_bytes(nkp); {Kinds of font penalties} - eval_four_bytes(nwp); {Words of font penalties} - end; - end; -if lf<>(header_length+lh+ncw+nw+nh+nd+ni+2*nl+nk+2*ne+np+ - nki+nwi+nkf+nwf+nkr+nwr+nkg+nwg+nkp+nwp) then - abort('Subfile sizes don''t add up to the stated total!'); -@.Subfile sizes don't add up...@> -if lh<2 then abort('The header length is only ',lh:1,'!'); -@.The header length...@> -if (2*nl)>(4*lig_size) then - abort('The lig/kern program is longer than I can handle!'); -@.The lig/kern program...@> -if (bc>ec+1)or(ec>top_char) then abort('The character code range ', -@.The character code range...@> - bc:1,'..',ec:1,'is illegal!'); -if ec>max_char then - abort('Character ',ec:1,'is too large. Ask a wizard to enlarge me.'); -if (nw=0)or(nh=0)or(nd=0)or(ni=0) then - abort('Incomplete subfiles for character dimensions!'); -@.Incomplete subfiles...@> -if ne>(top_char+1) then abort('There are ',ne:1,' extensible recipes!'); -@.There are ... recipes@> -end - -@ Once the input data successfully passes these basic checks, -\.{TFtoPL} believes that it is a \.{TFM} file, and the conversion -to \.{PL} format will take place. Access to the various subfiles -is facilitated by computing the following base addresses. For example, -the |char_info| for character |c| in a \.{TFM} file will start in location -|4*(char_base+c)| of the |tfm| array. - -@<Globals...@>= -@!ivalues_start,@!fvalues_start,@!mvalues_start, -@!rules_start,@!glues_start,@!penalties_start: -integer; -@!ivalues_base,@!fvalues_base,@!mvalues_base, -@!rules_base,@!glues_base,@!penalties_base: -integer; -@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base: integer; -@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer; - {base addresses for the subfiles} -@!char_start:array [0..max_char] of integer; -@!bytes_per_entry:integer; - -@ @<Compute the base addresses@>= -begin -ivalues_start:=header_length+lh; -fvalues_start:=ivalues_start+nki; -mvalues_start:=fvalues_start+nkf; -rules_start:=mvalues_start+nkm; -glues_start:=rules_start+nkr; -penalties_start:=glues_start+nkg; -ivalues_base:=penalties_start+nkp; -fvalues_base:=ivalues_base+nwi; -mvalues_base:=fvalues_base+nwi; -rules_base:=mvalues_base+nwm; -glues_base:=rules_base+nwr; -penalties_base:=glues_base+nwg; -char_base:=penalties_base+nwp; -bytes_per_entry:=(12 + 2*npc) div 4 * 4; -if not ofm_on then begin - for i:=bc to ec do begin - char_start[i]:=4*char_base+4*(i-bc); - end; - end -else if ofm_level=0 then begin - for i:=bc to ec do begin - char_start[i]:=4*char_base+8*(i-bc); - end; - end -else begin - char_ptr:=4*char_base; - i:=bc; - while i<=ec do begin - copies:=1+256*tfm[char_ptr+8]+tfm[char_ptr+9]; - for j:=1 to copies do begin - char_start[i]:=char_ptr; - i:=i+1; - end; - char_ptr:=char_ptr + bytes_per_entry; - end; - if char_ptr<>(4*(char_base+ncw)) then - abort('Length of char info table does not correspond to specification'); - end; -width_base:=char_base+ncw; -height_base:=width_base+nw; -depth_base:=height_base+nh; -italic_base:=depth_base+nd; -lig_kern_base:=italic_base+ni; -kern_base:=lig_kern_base+2*nl; -exten_base:=kern_base+nk; -param_base:=exten_base+2*ne-1; -end - -@ Of course we want to define macros that suppress the detail of how the -font information is actually encoded. Each word will be referred to by -the |tfm| index of its first byte. For example, if |c| is a character -code between |bc| and |ec|, then |tfm[char_info(c)]| will be the -first byte of its |char_info|, i.e., the |width_index|; furthermore -|width(c)| will point to the |fix_word| for |c|'s width. - -@d char_info(#)==char_start[#] -@d nonexistent(#)==((#<bc)or(#>ec)or(width_index(#)=0)) -@d width(#)==4*(width_base+width_index(#)) -@d height(#)==4*(height_base+height_index(#)) -@d depth(#)==4*(depth_base+depth_index(#)) -@d italic(#)==4*(italic_base+italic_index(#)) -@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character} -@d param(#)==4*(param_base+#) {likewise} - -@p function width_index(c:char_type):integer; -begin if not ofm_on then - width_index:=tfm[char_info(c)] -else - width_index:=256*tfm[char_info(c)]+tfm[char_info(c)+1]; -end; - -function height_index(c:char_type):integer; -begin if not ofm_on then - height_index:=tfm[char_info(c)+1] div 16 -else - height_index:=tfm[char_info(c)+2]; -end; - -function depth_index(c:char_type):integer; -begin if not ofm_on then - depth_index:=tfm[char_info(c)+1] mod 16 -else - depth_index:=tfm[char_info(c)+3]; -end; - -function italic_index(c:char_type):integer; -begin if not ofm_on then - italic_index:=tfm[char_info(c)+2] div 4 -else if ofm_level=0 then - italic_index:=tfm[char_info(c)+4]*64 + tfm[char_info(c)+5] div 4 -else - italic_index:=tfm[char_info(c)+4]; -end; - -function tag(c:char_type):integer; -begin if not ofm_on then - tag:=tfm[char_info(c)+2] mod 4 -else - tag:=tfm[char_info(c)+5] mod 4; -end; - -procedure set_no_tag(c:char_type); -begin if not ofm_on then - tfm[char_info(c)+2] := (tfm[char_info(c)+2] div 64)*64 + no_tag -else - tfm[char_info(c)+5] := (tfm[char_info(c)+5] div 64)*64 + no_tag; -end; - -function ctag(c:char_type):boolean; -begin if not (ofm_level=1) then - ctag:=false -else - ctag:=tfm[char_info(c)+5] div 4 mod 2; -end; - -procedure set_no_ctag(c:char_type); -begin if not (ofm_level=1) then - tfm[char_info(c)+5] := - tfm[char_info(c)+5] div 8 * 8 + tfm[char_info(c)+5] mod 4; -end; - -function no_repeats(c:char_type):integer; -begin if ofm_level<=0 then - no_repeats:=0 -else - no_repeats:=256*tfm[char_info(c)+8]+tfm[char_info(c)+9]; -end; - -function char_param(c:char_type; i:integer):integer; -begin - char_param:=256*tfm[char_info(c)+2*i+10]+tfm[char_info(c)+2*i+11]; -end; - -function rremainder(c:char_type):integer; -begin if not ofm_on then - rremainder:=tfm[char_info(c)+3] -else - rremainder:=256*tfm[char_info(c)+6]+tfm[char_info(c)+7]; -end; - -function lig_step(c:char_type):integer; -begin if not ofm_on then - lig_step:=4*(lig_kern_base+c) -else - lig_step:=4*(lig_kern_base+2*c); -end; - -function exten(c:char_type):integer; -begin if not ofm_on then - exten:=4*(exten_base+rremainder(c)) -else - exten:=4*(exten_base+2*rremainder(c)); -end; - -function l_skip_byte(c:integer):integer; -begin if not ofm_on then - l_skip_byte:=tfm[c] -else - l_skip_byte:=256*tfm[c]+tfm[c+1]; -end; - -procedure set_l_skip_byte(c:integer; newc:integer); -begin if not ofm_on then - tfm[c]:=newc -else begin - tfm[c]:=newc div 256; - tfm[c+1]:=newc mod 256 - end -end; - -function l_next_char(c:integer):integer; -begin if not ofm_on then - l_next_char:=tfm[c+1] -else - l_next_char:=256*tfm[c+2]+tfm[c+3]; -end; - -procedure set_l_next_char(c:integer; newc:char_type); -begin if not ofm_on then - tfm[c+1]:=newc -else begin - tfm[c+2]:=newc div 256; - tfm[c+3]:=newc mod 256 - end -end; - -function l_op_byte(c:integer):integer; -begin if not ofm_on then - l_op_byte:=tfm[c+2] -else - l_op_byte:=256*tfm[c+4]+tfm[c+5]; -end; - -procedure set_l_op_byte(c:integer; newc:integer); -begin if not ofm_on then - tfm[c+2]:=newc -else begin - tfm[c+2]:=newc div 256; - tfm[c+3]:=newc mod 256 - end -end; - -function l_remainder(c:integer):integer; -begin if not ofm_on then - l_remainder:=tfm[c+3] -else - l_remainder:=256*tfm[c+6]+tfm[c+7]; -end; - -procedure set_l_remainder(c:integer; newc:char_type); -begin if not ofm_on then - tfm[c+3]:=newc -else begin - tfm[c+6]:=newc div 256; - tfm[c+7]:=newc mod 256 - end -end; - -@ One of the things we would like to do is take cognizance of fonts whose -character coding scheme is \.{TeX math symbols} or \.{TeX math extension}; -we will set the |font_type| variable to one of the three choices -|vanilla|, |mathsy|, or |mathex|. - -@d vanilla=0 {not a special scheme} -@d mathsy=1 {\.{TeX math symbols} scheme} -@d mathex=2 {\.{TeX math extension} scheme} - -@<Glob...@>= -@!font_type:vanilla..mathex; {is this font special?} - -@* Unpacking the VF file. -Once the \.{TFM} file has been brought into memory, \.{VFtoVP} completes -the input phase by reading the \.{VF} information into another array of bytes. -In this case we don't store all the data; we check the redundant bytes -for consistency with their \.{TFM} counterparts, and we partially decode -the packets. - -@<Glob...@>= -@!vf:array[0..vf_size] of byte; {the \.{VF} input data goes here} -@!font_number:array[0..max_fonts] of integer; {local font numbers} -@!font_start,@!font_chars:array[0..max_fonts] of 0..vf_size; {font info} -@!font_ptr:0..max_fonts; {number of local fonts} -@!packet_start,@!packet_end:array[char_type] of 0..vf_size; - {character packet boundaries} -@!packet_found:boolean; {at least one packet has appeared} -@!temp_byte:byte;@+@!reg_count:integer; {registers for simple calculations} -@!real_dsize:real; {the design size, converted to floating point} -@!pl:integer; {packet length} -@!vf_ptr:0..vf_size; {first unused location in |vf|} -@!vf_count:integer; {number of bytes read from |vf_file|} - -@ Again we cautiously verify that we've been given decent data. - -@d read_vf(#)==read(vf_file,#) -@d vf_abort(#)==begin - print_ln(#); - print_ln('Sorry, but I can''t go on; are you sure this is a OVF?'); - goto final_end; - end - -@<Read the whole \.{VF} file@>= -read_vf(temp_byte); -if temp_byte<>pre then vf_abort('The first byte isn''t `pre''!'); -@.The first byte...@> -@<Read the preamble command@>; -@<Read and store the font definitions and character packets@>; -@<Read and verify the postamble@> - -@ @d vf_store(#)==@t@>@;@/ - if vf_ptr+#>=vf_size then vf_abort('The file is bigger than I can handle!'); -@.The file is bigger...@> - for k:=vf_ptr to vf_ptr+#-1 do - begin if eof(vf_file) then vf_abort('The file ended prematurely!'); -@.The file ended prematurely@> - read_vf(vf[k]); - end; - vf_count:=vf_count+#; vf_ptr:=vf_ptr+# - -@<Read the preamble command@>= -if eof(vf_file) then vf_abort('The input file is only one byte long!'); -@.The input...one byte long@> -read_vf(temp_byte); -if temp_byte<>id_byte then vf_abort('Wrong OVF version number in second byte!'); -@.Wrong OVF version...@> -if eof(vf_file) then vf_abort('The input file is only two bytes long!'); -read_vf(temp_byte); {read the length of introductory comment} -vf_count:=11; vf_ptr:=0; vf_store(temp_byte); -for k:=0 to vf_ptr-1 do print(xchr[vf[k]]); -print_ln(' '); reg_count:=0; -for k:=0 to 7 do - begin if eof(vf_file) then vf_abort('The file ended prematurely!'); -@.The file ended prematurely@> - read_vf(temp_byte); - if temp_byte=tfm[check_sum+k] then incr(reg_count); - end; -real_dsize:=(((tfm[design_size]*256+tfm[design_size+1])*256+tfm[design_size+2]) - *256+tfm[design_size+3])/@'4000000; -if reg_count<>8 then - begin print_ln('Check sum and/or design size mismatch.'); -@.Check sum...mismatch@> - print_ln('Data from OFM file will be assumed correct.'); - end - -@ @<Read and store the font definitions and character packets@>= -for k:=0 to 65535 do packet_start[k]:=vf_size; -font_ptr:=0; packet_found:=false; font_start[0]:=vf_ptr; -repeat if eof(vf_file) then - begin print_ln('File ended without a postamble!'); temp_byte:=post; -@.File ended without a postamble@> - end -else begin read_vf(temp_byte); incr(vf_count); - if temp_byte<>post then - if temp_byte>long_char then @<Read and store a font definition@> - else @<Read and store a character packet@>; - end; -until temp_byte=post - -@ @<Read and verify the postamble@>= -while (temp_byte=post)and not eof(vf_file) do - begin read_vf(temp_byte); incr(vf_count); - end; -if not eof(vf_file) then - begin print_ln('There''s some extra junk at the end of the OVF file.'); -@.There's some extra junk...@> - print_ln('I''ll proceed as if it weren''t there.'); - end; -if vf_count mod 4 <> 0 then - print_ln('VF data not a multiple of 4 bytes') -@.VF data not a multiple of 4 bytes@> - -@ @<Read and store a font definition@>= -begin if packet_found or(temp_byte>=pre) then - vf_abort('Illegal byte ',temp_byte:1,' at beginning of character packet!'); -@.Illegal byte...@> -font_number[font_ptr]:=vf_read(temp_byte-fnt_def1+1); -if font_ptr=max_fonts then vf_abort('I can''t handle that many fonts!'); -@.I can't handle that many fonts@> -vf_store(14); {|c[4]| |s[4]| |d[4]| |a[1]| |l[1]|} -if vf[vf_ptr-10]>0 then {|s| is negative or exceeds $2^{24}-1$} - vf_abort('Mapped font size is too big!'); -@.Mapped font size...big@> -a:=vf[vf_ptr-2]; l:=vf[vf_ptr-1]; vf_store(a+l); {|n[a+l]|} -@<Print the name of the local font@>; -@<Read the local font's \.{TFM} file and record the characters it contains@>; -incr(font_ptr); font_start[font_ptr]:=vf_ptr; -end - -@ The font area may need to be separated from the font name on some systems. -Here we simply reproduce the font area and font name (with no space -or punctuation between them). -@^system dependencies@> - -@<Print the name...@>= -print('MAPFONT ',font_ptr:1,': '); -for k:=font_start[font_ptr]+14 to vf_ptr-1 do print(xchr[vf[k]]); -k:=font_start[font_ptr]+5; -print_ln(' at ',(((vf[k]*256+vf[k+1])*256+vf[k+2])/@'4000000)*real_dsize:2:2, - 'pt') - -@ Now we must read in another \.{TFM} file. But this time we needn't be so -careful, because we merely want to discover which characters are present. -The next few sections of the program are copied pretty much verbatim from -\.{DVItype}, so that system-dependent modifications can be copied from existing -software. - -It turns out to be convenient to read four bytes at a time, when we are -inputting from the local \.{TFM} files. The input goes into global variables -|b0|, |b1|, |b2|, and |b3|, with |b0| getting the first byte and |b3| -the fourth. - -@<Glob...@>= -@!a:integer; {length of the area/directory spec} -@!l:integer; {length of the font name proper} -@!cur_name:packed array[1..name_length] of char; {external name, - with no lower case letters} -@!b0,@!b1,@!b2,@!b3: byte; {four bytes input at once} -@!font_lh:integer; {header length of current local font} -@!font_bc,@!font_ec:integer; {character range of current local font} -@!font_ofm_level,@!font_extra_words:integer; -@!font_kprime,@!font_j:integer; - -@ The |read_tfm_word| procedure sets |b0| through |b3| to the next -four bytes in the current \.{TFM} file. -@^system dependencies@> - -@d read_tfm(#)==if eof(tfm_file) then #:=0@+else read(tfm_file,#) - -@p procedure read_tfm_word; -begin read_tfm(b0); read_tfm(b1); -read_tfm(b2); read_tfm(b3); -end; - -@ We use the |vf| array to store a list of all valid characters in the -local font, beginning at location |font_chars[f]|. - -@<Read the local font's \.{TFM} file...@>= -font_chars[font_ptr]:=vf_ptr; -@<Move font name into the |cur_name| string@>; -reset(tfm_file,cur_name); -@^system dependencies@> -if eof(tfm_file) then - print_ln('---not loaded, font metric file can''t be opened!') -@.font metric file can\'t be opened@> -else begin font_bc:=0; font_ec:=65536; {will cause error if not modified soon} - @<Read past the header@>; - if font_bc<=font_ec then - if font_ec>65535 then print_ln('---not loaded, bad font metric file!') -@.bad font metric file@> - else @<Read |char_info| entries@>; - if eof(tfm_file) then - print_ln('---trouble is brewing, font metric file ended too soon!'); -@.trouble is brewing...@> - end; -incr(vf_ptr) {leave space for character search later} - -@ @<Read past the header@>= -read_tfm_word; -if (b0*256+b1)<>0 then begin {TFM file} - font_ofm_level:=-1; - font_lh:=b2*256+b3; - read_tfm_word; font_bc:=b0*256+b1; font_ec:=b2*256+b3; - if font_ec<font_bc then font_bc:=font_ec+1; - read_tfm_word; - for k:=1 to 3+font_lh do begin - read_tfm_word; - if k=4 then @<Check the check sum@>; - if k=5 then @<Check the design size@>; - end; - end -else begin - font_ofm_level:=b2*256+b3; - read_tfm_word; font_lh:=((b0*256+b1)*256+b2)*256+b3; - read_tfm_word; font_bc:=((b0*256+b1)*256+b2)*256+b3; - read_tfm_word; font_ec:=((b0*256+b1)*256+b2)*256+b3; - if font_ec<font_bc then font_bc:=font_ec+1; - read_tfm_word; - for k:=1 to 8 do begin - read_tfm_word; - end; - if font_ofm_level=1 then begin - read_tfm_word; read_tfm_word; read_tfm_word; - font_extra_words:=(((b0*256+b1)*256+b2)*256+b3) div 2; - for k:=1 to 5 do begin - read_tfm_word; - end; - end; - for k:=1 to lh do begin - read_tfm_word; - if k=1 then @<Check the check sum@>; - if k=2 then @<Check the design size@>; - end; - end - -@ @<Read |char_info| entries@>= -case font_ofm_level of - -1: begin - for k:=font_bc to font_ec do begin - read_tfm_word; - if b0>0 then begin {character |k| exists in the font} - vf[vf_ptr]:=k; incr(vf_ptr); - if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!'); - end; - end; - end; - 0: begin - for k:=font_bc to font_ec do - begin read_tfm_word; - if (b0*256+b1)>0 then {character |k| exists in the font} - begin vf[vf_ptr]:=k; incr(vf_ptr); - if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!'); - end; - read_tfm_word; - end; - end; - 1: begin - k:=font_bc; - while k<font_ec do begin - read_tfm_word; - if (b0*256+b1)>0 then begin {character |k| exists in the font} - vf[vf_ptr]:=k; incr(vf_ptr); - if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!'); - end; - read_tfm_word; read_tfm_word; - font_kprime:=k+(b0*256+b1); - for font_j:=k+1 to font_kprime do begin - vf[vf_ptr]:=font_j; incr(vf_ptr); - if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!'); - end; - k:=font_kprime; - for font_j:=1 to font_extra_words do - read_tfm_word; - end - end; -end; - -@ @<Check the check sum@>= -if b0+b1+b2+b3>0 then - if(b0<>vf[font_start[font_ptr]])or@| - (b1<>vf[font_start[font_ptr]+1])or@| - (b2<>vf[font_start[font_ptr]+2])or@| - (b3<>vf[font_start[font_ptr]+3]) then begin - print_ln('Check sum in OVF file being replaced by font metric check sum'); -@.Check sum...replaced...@> - vf[font_start[font_ptr]]:=b0; - vf[font_start[font_ptr]+1]:=b1; - vf[font_start[font_ptr]+2]:=b2; - vf[font_start[font_ptr]+3]:=b3; - end - -@ @<Check the design size@>= -if(b0<>vf[font_start[font_ptr]+8])or@| - (b1<>vf[font_start[font_ptr]+9])or@| - (b2<>vf[font_start[font_ptr]+10])or@| - (b3<>vf[font_start[font_ptr]+11]) then - begin print_ln('Design size in OVF file being replaced by font metric design size'); -@.Design size...replaced...@> - vf[font_start[font_ptr]+8]:=b0; - vf[font_start[font_ptr]+9]:=b1; - vf[font_start[font_ptr]+10]:=b2; - vf[font_start[font_ptr]+11]:=b3; - end - -@ If no font directory has been specified, \.{DVI}-reading software -is supposed to use the default font directory, which is a -system-dependent place where the standard fonts are kept. -The string variable |default_directory| contains the name of this area. -@^system dependencies@> - -@d default_directory_name=='TeXfonts:' {change this to the correct name} -@d default_directory_name_length=9 {change this to the correct length} - -@<Glob...@>= -@!default_directory:packed array[1..default_directory_name_length] of char; - -@ @<Set init...@>= -default_directory:=default_directory_name; - -@ The string |cur_name| is supposed to be set to the external name of the -\.{TFM} file for the current font. This usually means that we need to -prepend the name of the default directory, and -to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters -to upper case, since |cur_name| is a \PASCAL\ string. -@^system dependencies@> - -@<Move font name into the |cur_name| string@>= -for k:=1 to name_length do cur_name[k]:=' '; -if a=0 then begin - for k:=1 to default_directory_name_length do - cur_name[k]:=default_directory[k]; - r:=default_directory_name_length; - end -else r:=0; -for k:=font_start[font_ptr]+14 to vf_ptr-1 do begin - incr(r); - if r+4>name_length then vf_abort('Font name too long for me!'); -@.Font name too long for me@> - if (vf[k]>="a")and(vf[k]<="z") then - cur_name[r]:=xchr[vf[k]-@'40] - else cur_name[r]:=xchr[vf[k]]; - end; -cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M' - - -@ It's convenient to have a subroutine -that reads a |k|-byte number from |vf_file|. - -@d get_vf(#)==if eof(vf_file) then #:=0 @+else read_vf(#) - -@p function vf_read(@!k:integer):integer; {actually |1<=k<=4|} -var @!b:byte; {input byte} -@!a:integer; {accumulator} -begin vf_count:=vf_count+k; get_vf(b); a:=b; -if k=4 then if b>=128 then a:=a-256; {4-byte numbers are signed} -while k>1 do begin - get_vf(b); - a:=256*a+b; decr(k); - end; -vf_read:=a; -end; - -@ The \.{VF} format supports arbitrary 4-byte character codes, -but \.{VPL} format presently does not. But \.{OVP} does. - -@<Read and store a character packet@>= -begin if temp_byte=long_char then - begin pl:=vf_read(4); c:=vf_read(4); reg_count:=vf_read(4); - {|pl[4]| |cc[4]| |tfm[4]|} - end -else begin pl:=temp_byte; c:=vf_read(1); reg_count:=vf_read(3); - {|pl[1]| |cc[1]| |tfm[3]|} - end; -if nonexistent(c) then vf_abort('Character ',c:1,' does not exist!'); -@.Character c does not exist@> -if packet_start[c]<vf_size then - print_ln('Discarding earlier packet for character ',c:1); -@.Discarding earlier packet...@> -if reg_count<>tfm_width(c) then - print_ln('Incorrect OFM width for character ',c:1,' in OVF file'); -@.Incorrect OFM width...@> -if pl<0 then vf_abort('Negative packet length!'); -@.Negative packet length@> -packet_start[c]:=vf_ptr; vf_store(pl); packet_end[c]:=vf_ptr-1; -packet_found:=true; -end - -@ The preceding code requires a simple subroutine that evaluates \.{TFM} data. - -@p function tfm_width(@!c:integer):integer; -var @!a:integer; {accumulator} -@!k:index; {index into |tfm|} -begin k:=width(c); {we assume that character |c| exists} -a:=tfm[k]; -if a>=128 then a:=a-256; -tfm_width:=((256*a+tfm[k+1])*256+tfm[k+2])*256+tfm[k+3]; -end; - -@* Basic output subroutines. -Let us now define some procedures that will reduce the rest of \.{VFtoVP}'s -work to a triviality. - -First of all, it is convenient to have an abbreviation for output to the -\.{VPL} file: - -@d out(#)==write(vpl_file,#) - -@ In order to stick to standard \PASCAL, we use an |xchr| array to do -appropriate conversion of ASCII codes. Three other little strings are -used to produce |face| codes like \.{MIE}. - -@<Glob...@>= -@!ASCII_04,@!ASCII_10,@!ASCII_14,HEX: packed array [1..32] of char; - {strings for output in the user's external character set} -@!xchr:packed array [0..255] of char; -@!MBL_string,@!RI_string,@!RCE_string:packed array [1..3] of char; - {handy string constants for |face| codes} - -@ @<Set init...@>= -ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/ -ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/ -ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~?';@/ -HEX:='0123456789ABCDEF';@/ -for k:=0 to 255 do xchr[k]:='?'; -for k:=0 to @'37 do begin - xchr[k+@'40]:=ASCII_04[k+1]; - xchr[k+@'100]:=ASCII_10[k+1]; - xchr[k+@'140]:=ASCII_14[k+1]; - end; -MBL_string:='MBL'; RI_string:='RI '; RCE_string:='RCE'; - -@ The array |dig| will hold a sequence of digits to be output. - -@<Glob...@>= -@!dig:array[0..11] of integer; - -@ Here, in fact, are two procedures that output -|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$. - -@p procedure out_digs(j:integer); {outputs |j| digits} -begin repeat decr(j); out(HEX[1+dig[j]]); - until j=0; -end; -@# -procedure print_digs(j:integer); {prints |j| digits} -begin repeat decr(j); print(HEX[1+dig[j]]); - until j=0; -end; - -@ The |print_number| procedure indicates how |print_digs| can be used. -This procedure can print in octal, decimal or hex notation. - -@d print_hex(#)==print_number(#,16) -@d print_octal(#)==print_number(#,8) -@d print_decimal(#)==print_number(#,10) - -@p procedure print_number(c:integer; form:integer); {prints value of |c|} -var j:0..32; {index into |dig|} -begin -j:=0; -if (c<0) then begin - print_ln('Internal error: print_number (negative value)'); - c:=0; - end; -if form=8 then - print('''') {an apostrophe indicates the octal notation} -else if form=16 then - print('"') { a double apostrophe indicates the hexadecimal notation} -else if form<>10 then begin - print_ln('Internal error: print_number (form)'); - form:=16; - end; -while (c>0) or (j=0) do begin - dig[j]:=c mod form; c:=c div form; - j:=j+1; - end; -print_digs(j); -end; - -@ A \.{VPL} file has nested parentheses, and we want to format the output -so that its structure is clear. The |level| variable keeps track of the -depth of nesting. - -@<Glob...@>= -@!level:0..5; - -@ @<Set init...@>= -level:=0; - -@ Three simple procedures suffice to produce the desired structure in the -output. - -@p procedure out_ln; {finishes one line, indents the next} -var l:0..5; -begin write_ln(vpl_file); -for l:=1 to level do out(' '); -end; -@# -procedure left; {outputs a left parenthesis} -begin incr(level); out('('); -end; -@# -procedure right; {outputs a right parenthesis and finishes a line} -begin decr(level); out(')'); out_ln; -end; - -@ The value associated with a property can be output in a variety of -ways. For example, we might want to output a {\mc BCPL} string that -begins in |tfm[k]|: - -@p procedure out_BCPL(@!k:index); {outputs a string, preceded by a blank space} -var l:0..39; {the number of bytes remaining} -begin out(' '); l:=tfm[k]; -while l>0 do begin - incr(k); decr(l); out(xchr[tfm[k]]); - end; -end; - -@ The property value might also be a sequence of |l| bytes, beginning -in |tfm[k]|, that we would like to output in hex notation. -The following procedure assumes that |l<=4|, but larger values of |l| -could be handled easily by enlarging the |dig| array and increasing -the upper bounds on |b| and |j|. - -@d out_octal_number(#)==out_number(#,8) -@d out_decimal_number(#)==out_number(#,10) -@d out_hex_number(#)==out_number(#,16) -@d out_dec(#)==out_decimal_number(#) -@d out_hex_char(#)==out_hex_number(#) - -@p procedure out_number(c:integer; form:integer); {outputs value of |c|} -var j:0..32; {index into |dig|} -begin -j:=0; -if (c<0) then begin - print_ln('Internal error: print_number (negative value)'); - c:=0; - end; -if form=8 then - out(' O ') -else if form=10 then - out(' D ') -else if form=16 then - out(' H ') -else begin - print_ln('Internal error: print_number (form)'); - form:=16; - out(' H ') - end; -while (c>0) or (j=0) do begin - dig[j]:=c mod form; c:=c div form; - j:=j+1; - end; -out_digs(j); -end; -@# -procedure out_hex(@!k,@!l:index); - {outputs |l| bytes in hex} -var a:0..@"7FFFFFFF; {accumulator for bits not yet output} -@!b:0..32; {the number of significant bits in |a|} -@!j:0..11; {the number of digits of output} -begin -out(' H '); -a:=0; b:=0; j:=0; -while l>0 do @<Reduce \(1)|l| by one, preserving the invariants@>; -while (a>0)or(j=0) do begin - dig[j]:=a mod 16; a:=a div 16; incr(j); - end; -out_digs(j); -end; - -@ @<Reduce \(1)|l|...@>= -begin decr(l); -if tfm[k+l]<>0 then begin - while b>2 do begin - dig[j]:=a mod 16; a:=a div 16; b:=b-4; incr(j); - end; - case b of - 0: a:=tfm[k+l]; - 1:a:=a+2*tfm[k+l]; - 2:a:=a+4*tfm[k+l]; - 3:a:=a+8*tfm[k+l]; - end; - end; -b:=b+8; -end - -@ The property value may be a character, which is output in hex -unless it is a letter or a digit. This procedure is the only place -where a lowercase letter will be output to the \.{PL} file. -@^system dependencies@> - -@p procedure out_char(@!c:integer); {outputs a character} -begin if font_type>vanilla then - out_hex_char(c) -else if (c>="0")and(c<="9") then - out(' C ',c-"0":1) -else if (c>="A")and(c<="Z") then - out(' C ',ASCII_10[c-"A"+2]) -else if (c>="a")and(c<="z") then - out(' C ',ASCII_14[c-"a"+2]) -else out_hex_char(c); -end; - -@ The property value might be a ``face'' byte, which is output in the -curious code mentioned earlier, provided that it is less than 18. - -@p procedure out_face(@!k:index); {outputs a |face|} -var s:0..1; {the slope} -@!b:0..8; {the weight and expansion} -begin if tfm[k]>=18 then out_hex(k,1) -else begin - out(' F '); {specify face-code format} - s:=tfm[k] mod 2; b:=tfm[k] div 2; - out(MBL_string[1+(b mod 3)]); - out(RI_string[1+s]); - out(RCE_string[1+(b div 3)]); - end; -end; - -@ And finally, the value might be a |fix_word|, which is output in -decimal notation with just enough decimal places for \.{VPtoVF} -to recover every bit of the given |fix_word|. - -All of the numbers involved in the intermediate calculations of -this procedure will be nonnegative and less than $10\cdot2^{24}$. - -@p procedure out_fix(@!k:index); {outputs a |fix_word|} -var a:0..@'7777; {accumulator for the integer part} -@!f:integer; {accumulator for the fraction part} -@!j:0..12; {index into |dig|} -@!delta:integer; {amount if allowable inaccuracy} -begin out(' R '); {specify real format} -a:=(tfm[k]*16)+(tfm[k+1] div 16); -f:=((tfm[k+1] mod 16)*@'400+tfm[k+2])*@'400+tfm[k+3]; -if a>@'3777 then @<Reduce \(2)negative to positive@>; -@<Output the integer part, |a|, in decimal notation@>; -@<Output the fraction part, $|f|/2^{20}$, in decimal notation@>; -end; - -@ The following code outputs at least one digit even if |a=0|. - -@<Output the integer...@>= -begin j:=0; -repeat dig[j]:=a mod 10; a:=a div 10; incr(j); -until a=0; -out_digs(j); -end - -@ And the following code outputs at least one digit to the right -of the decimal point. - -@<Output the fraction...@>= -begin out('.'); f:=10*f+5; delta:=10; -repeat if delta>@'4000000 then f:=f+@'2000000-(delta div 2); -out(f div @'4000000:1); f:=10*(f mod @'4000000); delta:=delta*10; -until f<=delta; -end; - -@ @<Reduce \(2)negative to positive@>= -begin out('-'); a:=@'10000-a; -if f>0 then begin - f:=@'4000000-f; decr(a); - end; -end - -@* Outputting the TFM info. -\TeX\ checks the information of a \.{TFM} file for validity as the -file is being read in, so that no further checks will be needed when -typesetting is going on. And when it finds something wrong, it justs -calls the file ``bad,'' without identifying the nature of the problem, -since \.{TFM} files are supposed to be good almost all of the time. - -Of course, a bad file shows up every now and again, and that's where -\.{VFtoVP} comes in. This program wants to catch at least as many errors as -\TeX\ does, and to give informative error messages besides. -All of the errors are corrected, so that the \.{VPL} output will -be correct (unless, of course, the \.{TFM} file was so loused up -that no attempt is being made to fathom it). - -@ Just before each character is processed, its code is printed in hex -notation. Up to eight such codes appear on a line; so we have a variable -to keep track of how many are currently there. We also keep track of -whether or not any errors have had to be corrected. - -@<Glob...@>= -@!chars_on_line:0..8; {the number of characters printed on the current line} -@!perfect:boolean; {was the file free of errors?} - -@ @<Set init...@>= -chars_on_line:=0;@/ -perfect:=true; {innocent until proved guilty} - -@ Error messages are given with the help of the |bad| and |range_error| -and |bad_char| macros: - -@d bad(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' '); - chars_on_line:=0; print_ln('Bad OFM file: ',#); - end -@.Bad OFM file@> -@d range_error(#)==begin perfect:=false; print_ln(' '); - print(#,' index for character '); - print_hex(c); print_ln(' is too large;'); - print_ln('so I reset it to zero.'); - end -@d bad_char_tail(#)==print_hex(#); print_ln('.'); - end -@d bad_char(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' '); - chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character '); - bad_char_tail -@d correct_bad_char_tail(#)==#(k,0) - end -@d correct_bad_char_middle(#)==print_hex(#(k)); print_ln('.'); - correct_bad_char_tail -@d correct_bad_char(#)== begin perfect:=false; - if chars_on_line>0 then print_ln(' '); - chars_on_line:=0; print('Bad OFM file: ',#,' nonexistent character '); - correct_bad_char_middle - -@<Glob...@>= -@!i:integer; {an index to words of a subfile} -@!c:xchar_type; {a random character} -@!d:0..3; {byte number in a word} -@!k:index; {a random index} -@!r:0..65535; {a random two-byte value} -@!count:0..127; {for when we need to enumerate a small set} - -@ There are a lot of simple things to do, and they have to be done one -at a time, so we might as well get down to business. The first things -that \.{VFtoVP} will put into the \.{VPL} file appear in the header part. - -@<Do the header@>= -begin -case ofm_level of - 0: begin out('(OFMLEVEL H 0)'); out_ln; end; - 1: begin out('(OFMLEVEL H 1)'); out_ln; end; - end; -if ofm_on then begin - left; - if font_dir<=7 then out('FONTDIR') - else out('NFONTDIR'); - case font_dir mod 8 of - 0: out(' TL'); - 1: out(' LT'); - 2: out(' TR'); - 3: out(' LB'); - 4: out(' BL'); - 5: out(' RT'); - 6: out(' BR'); - 7: out(' RB'); - end; - right - end; -font_type:=vanilla; -if lh>=12 then begin - @<Set the true |font_type|@>; - if lh>=17 then begin - @<Output the family name@>; - if lh>=18 then @<Output the rest of the header@>; - end; - @<Output the character coding scheme@>; - end; -@<Output the design size@>; -@<Output the check sum@>; -@<Output the |seven_bit_safe_flag|@>; -end - -@ @<Output the check sum@>= -left; out('CHECKSUM'); out_hex(check_sum,4); -right - -@ Incorrect design sizes are changed to 10 points. - -@d bad_design(#)==begin bad('Design size ',#,'!'); -@.Design size wrong@> - print_ln('I''ve set it to 10 points.'); - out(' D 10'); - end - -@ @<Output the design size@>= -left; out('DESIGNSIZE'); -if tfm[design_size]>127 then bad_design('negative') -else if (tfm[design_size]=0)and(tfm[design_size+1]<16) then - bad_design('too small') -else out_fix(design_size); -right; -out('(COMMENT DESIGNSIZE IS IN POINTS)'); out_ln; -out('(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)'); out_ln -@.DESIGNSIZE IS IN POINTS@> - -@ Since we have to check two different {\mc BCPL} strings for validity, -we might as well write a subroutine to make the check. - -@p procedure check_BCPL(@!k,@!l:index); {checks a string of length |<l|} -var j:index; {runs through the string} -@!c:integer; {character being checked} -begin if tfm[k]>=l then begin - bad('String is too long; I''ve shortened it drastically.'); -@.String is too long...@> - tfm[k]:=1; - end; -for j:=k+1 to k+tfm[k] do begin - c:=tfm[j]; - if (c="(")or(c=")") then - begin bad('Parenthesis in string has been changed to slash.'); -@.Parenthesis...changed to slash@> - tfm[j]:="/"; - end - else if (c<" ")or(c>"~") then begin - bad('Nonstandard ASCII code has been blotted out.'); -@.Nonstandard ASCII code...@> - tfm[j]:="?"; - end - else if (c>="a")and(c<="z") then tfm[j]:=c+"A"-"a"; {upper-casify letters} - end; -end; - -@ The |font_type| starts out |vanilla|; possibly we need to reset it. - -@<Set the true |font_type|@>= -begin check_BCPL(scheme,40); -if (tfm[scheme]>=11)and@|(tfm[scheme+1]="T")and@| - (tfm[scheme+2]="E")and@|(tfm[scheme+3]="X")and@| - (tfm[scheme+4]=" ")and@|(tfm[scheme+5]="M")and@| - (tfm[scheme+6]="A")and@|(tfm[scheme+7]="T")and@| - (tfm[scheme+8]="H")and@|(tfm[scheme+9]=" ") then begin - if (tfm[scheme+10]="S")and(tfm[scheme+11]="Y") then font_type:=mathsy - else if (tfm[scheme+10]="E")and(tfm[scheme+11]="X") then font_type:=mathex; - end; -end - -@ @<Output the character coding scheme@>= -left; out('CODINGSCHEME'); -out_BCPL(scheme); -right - -@ @<Output the family name@>= -left; out('FAMILY'); -check_BCPL(family,20); -out_BCPL(family); -right - -@ @<Output the rest of the header@>= -begin left; out('FACE'); out_face(random_word+3); right; -for i:=18 to lh-1 do begin - left; out('HEADER D ',i:1); - out_hex(check_sum+4*i,@,4); right; - end; -end - -@ This program does not check to see if the |seven_bit_safe_flag| has the -correct setting, i.e., if it really reflects the seven-bit-safety of -the \.{TFM} file; the stated value is merely put into the \.{VPL} file. -The \.{VPtoVF} program will store a correct value and give a warning -message if a file falsely claims to be safe. - -@<Output the |seven_bit_safe_flag|@>= -if (lh>17) and (tfm[random_word]>127) then begin - left; out('SEVENBITSAFEFLAG FALSE'); right; - end - -@ The next thing to take care of is the list of parameters. - -@<Do the parameters@>= -if np>0 then begin - left; out('FONTDIMEN'); out_ln; - for i:=1 to np do @<Check and output the $i$th parameter@>; - right; - end; -@<Check to see if |np| is complete for this font type@>; - -@ @<Check to see if |np|...@>= -if (font_type=mathsy)and(np<>22) then - print_ln('Unusual number of fontdimen parameters for a math symbols font (', -@.Unusual number of fontdimen...@> - np:1,' not 22).') -else if (font_type=mathex)and(np<>13) then - print_ln('Unusual number of fontdimen parameters for an extension font (', - np:1,' not 13).') - -@ All |fix_word| values except the design size and the first parameter -will be checked to make sure that they are less than 16.0 in magnitude, -using the |check_fix| macro: - -@d check_fix_tail(#)==bad(#,' ',i:1,' is too big;'); - print_ln('I have set it to zero.'); - end -@d check_fix(#)==if (tfm[#]>0)and(tfm[#]<255) then - begin tfm[#]:=0; tfm[(#)+1]:=0; tfm[(#)+2]:=0; tfm[(#)+3]:=0; - check_fix_tail - -@<Check and output the $i$th parameter@>= -begin left; -if i=1 then out('SLANT') {this parameter is not checked} -else begin check_fix(param(i))('Parameter');@/ -@.Parameter n is too big@> - @<Output the name of parameter $i$@>; - end; -out_fix(param(i)); right; -end - -@ @<Output the name...@>= -if i<=7 then case i of - 2:out('SPACE');@+3:out('STRETCH');@+4:out('SHRINK'); - 5:out('XHEIGHT');@+6:out('QUAD');@+7:out('EXTRASPACE')@+end -else if (i<=22)and(font_type=mathsy) then case i of - 8:out('NUM1');@+9:out('NUM2');@+10:out('NUM3'); - 11:out('DENOM1');@+12:out('DENOM2'); - 13:out('SUP1');@+14:out('SUP2');@+15:out('SUP3'); - 16:out('SUB1');@+17:out('SUB2'); - 18:out('SUPDROP');@+19:out('SUBDROP'); - 20:out('DELIM1');@+21:out('DELIM2'); - 22:out('AXISHEIGHT')@+end -else if (i<=13)and(font_type=mathex) then - if i=8 then out('DEFAULTRULETHICKNESS') - else out('BIGOPSPACING',i-8:1) -else out('PARAMETER D ',i:1) - -@ @<Glob...@>= -@!start_counter,@!base_counter,@!number_entries:integer; -@!value:integer; - -@ @<Do the ivalue parameters@>= -if nki>0 then begin - start_counter:=ivalues_start*4; - base_counter:=ivalues_base*4; - for i:=0 to nki-1 do @<Check and output the $i$th ivalue table@>; - end; - -@ @<Check and output the $i$th ivalue table@>= -begin -left; out('FONTIVALUE'); out_hex_number(i); out_ln; -number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; -for j:=0 to number_entries-1 do begin - left; out('IVALUE'); out_hex_number(j); out_ln; - value:=256*tfm[base_counter+2]+tfm[base_counter+3]; - left; out('IVALUEVAL'); out_hex_number(value); right; - right; - base_counter:=base_counter+4; - end; -right; -start_counter:=start_counter+4;; -end; - -@ @<Do the fvalue parameters@>= -if nkf>0 then begin - start_counter:=fvalues_start*4; - base_counter:=fvalues_base*4; - for i:=0 to nkf-1 do @<Check and output the $i$th fvalue table@>; - end; - -@ @<Check and output the $i$th fvalue table@>= -begin -left; out('FONTFVALUE'); out_hex_number(i); out_ln; -number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; -for j:=0 to number_entries-1 do begin - left; out('FVALUE'); out_hex_number(j); out_ln; - left; out('FVALUEVAL'); out_fix(base_counter); right; - right; - base_counter:=base_counter+4; - end; -right; -start_counter:=start_counter+4; -end; - -@ @<Do the mvalue parameters@>= -if nkm>0 then begin - start_counter:=mvalues_start*4; - base_counter:=mvalues_base*4; - for i:=0 to nkm-1 do @<Check and output the $i$th mvalue table@>; - end; - -@ @<Check and output the $i$th mvalue table@>= -begin -left; out('FONTMVALUE'); out_hex_number(i); out_ln; -number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; -for j:=0 to number_entries-1 do begin - left; out('MVALUE'); out_hex_number(j); out_ln; - left; out('MVALUEVAL'); out_fix(base_counter); right; - right; - base_counter:=base_counter+4; - end; -right; -start_counter:=start_counter+4; -end; - -@ @<Do the rule parameters@>= -if nkr>0 then begin - start_counter:=rules_start*4; - base_counter:=rules_base*4; - for i:=0 to nkr-1 do @<Check and output the $i$th rule table@>; - end; - -@ @<Check and output the $i$th rule table@>= -begin -left; out('FONTRULE'); out_hex_number(i); out_ln; -number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; -for j:=0 to number_entries-1 do begin - left; out('RULE'); out_hex_number(j); out_ln; - left; out('RULEWD'); out_fix(base_counter); right; - left; out('RULEHT'); out_fix(base_counter+4); right; - left; out('RULEDP'); out_fix(base_counter+8); right; - right; - base_counter:=base_counter+12; - end; -right; -start_counter:=start_counter+4; -end; - -@ @<Do the glue parameters@>= -if nkg>0 then begin - start_counter:=glues_start*4; - base_counter:=glues_base*4; - for i:=0 to nkg-1 do @<Check and output the $i$th glue table@>; - end; - -@ @<Glob...@>= -@!glue_subtype,@!glue_argument_kind,@!glue_stretch_order, -@!glue_shrink_order,@!glue_argument:integer; - -@ @<Check and output the $i$th glue table@>= -begin -left; out('FONTGLUE'); out_hex_number(i); out_ln; -number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; -for j:=0 to number_entries-1 do begin - left; out('GLUE'); out_hex_number(j); out_ln; - glue_subtype:=tfm[base_counter] div 16; - glue_argument_kind:=tfm[base_counter] mod 16; - glue_stretch_order:=tfm[base_counter+1] div 16; - glue_shrink_order:=tfm[base_counter+1] mod 16; - glue_argument:=tfm[base_counter+2]*256+tfm[base_counter+3]; - left; - out('GLUETYPE'); - case glue_subtype of - 0: out(' H 0'); - 1: out(' H 1'); - 2: out(' H 2'); - 3: out(' H 3'); - end; - right; - case glue_argument_kind of - 1: begin - left; out('GLUERULE'); out_hex_number(glue_argument); right; - end; - 2: begin - left; out('GLUECHAR'); out_hex_number(glue_argument); right; - end; - end; - left; - out('GLUESTRETCHORDER'); - case glue_stretch_order of - 0: out(' H 0'); - 1: out(' H 1'); - 2: out(' H 2'); - 3: out(' H 3'); - 4: out(' H 4'); - end; - right; - left; - out('GLUESHRINKORDER'); - case glue_shrink_order of - 0: out(' H 0'); - 1: out(' H 1'); - 2: out(' H 2'); - 3: out(' H 3'); - 4: out(' H 4'); - end; - right; - left; out('GLUEWD'); out_fix(base_counter+4); right; - left; out('GLUESTRETCH'); out_fix(base_counter+8); right; - left; out('GLUESHRINK'); out_fix(base_counter+12); right; - right; - base_counter:=base_counter+16; - end; -right; -start_counter:=start_counter+4; -end; - -@ @<Do the penalty parameters@>= -if nkp>0 then begin - start_counter:=penalties_start*4; - base_counter:=penalties_base*4; - for i:=0 to nkp-1 do @<Check and output the $i$th penalty table@>; - end; - -@ @<Check and output the $i$th penalty table@>= -begin -left; out('FONTPENALTY'); out_hex_number(i); out_ln; -number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3]; -for j:=0 to number_entries-1 do begin - left; out('PENALTY'); out_hex_number(j); out_ln; - value:=256*tfm[base_counter+2]+tfm[base_counter+3]; - left; out('PENALTYVAL'); out_hex_number(value); right; - right; - base_counter:=base_counter+4; - end; -right; -start_counter:=start_counter+4; -end; - -@ We need to check the range of all the remaining |fix_word| values, -and to make sure that |width[0]=0|, etc. - -@d nonzero_fix(#)==(tfm[#]>0)or(tfm[#+1]>0)or(tfm[#+2]>0)or(tfm[#+3]>0) - -@<Check the |fix_word| entries@>= -if nonzero_fix(4*width_base) then bad('width[0] should be zero.'); -@.should be zero@> -if nonzero_fix(4*height_base) then bad('height[0] should be zero.'); -if nonzero_fix(4*depth_base) then bad('depth[0] should be zero.'); -if nonzero_fix(4*italic_base) then bad('italic[0] should be zero.'); -for i:=0 to nw-1 do check_fix(4*(width_base+i))('Width'); -@.Width n is too big@> -for i:=0 to nh-1 do check_fix(4*(height_base+i))('Height'); -@.Height n is too big@> -for i:=0 to nd-1 do check_fix(4*(depth_base+i))('Depth'); -@.Depth n is too big@> -for i:=0 to ni-1 do check_fix(4*(italic_base+i))('Italic correction'); -@.Italic correction n is too big@> -if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern'); -@.Kern n is too big@> - -@ The ligature/kerning program comes next. Before we can put it out in -\.{PL} format, we need to make a table of ``labels'' that will be inserted -into the program. For each character |c| whose |tag| is |lig_tag| and -whose starting address is |r|, we will store the pair |(c,r)| in the -|label_table| array. If there's a boundary-char program starting at~|r|, -we also store the pair |(256,r)|. -This array is sorted by its second components, using the -simple method of straight insertion. - -@<Glob...@>= -@!label_table:array[xxxchar_type] of record -@!cc:xchar_type;@!rr:0..lig_size;ischar:boolean;end; -@!label_ptr:xxchar_type; {the largest entry in |label_table|} -@!sort_ptr:xxchar_type; {index into |label_table|} -@!boundary_char:xchar_type; {boundary character, or |xmax_char| if none} -@!bchar_label:0..xmax_label; {beginning of boundary character program} - -@ @<Set init...@>= -boundary_char:=xmax_char; bchar_label:=xmax_label;@/ -label_ptr:=0; label_table[0].rr:=0; {a sentinel appears at the bottom} - -@ We'll also identify and remove inaccessible program steps, using the -|activity| array. - -@d unreachable=0 {a program step not known to be reachable} -@d pass_through=1 {a program step passed through on initialization} -@d accessible=2 {a program step that can be relevant} - -@<Glob...@>= -@!activity:array[0..lig_size] of unreachable..accessible; -@!ai,@!acti:0..lig_size; {indices into |activity|} - -@ @<Do the ligatures and kerns@>= -if nl>0 then begin - for ai:=0 to (nl-1) do activity[ai]:=unreachable; - @<Check for a boundary char@>; - end; -@<Build the label table@>; -if nl>0 then begin - left; out('LIGTABLE'); out_ln;@/ - @<Compute the |activity| array@>; - @<Output and correct the ligature/kern program@>; - right; - @<Check for ligature cycles@>; - end - -@ We build the label table even when |nl=0|, because this catches errors -that would not otherwise be detected. - -@<Build...@>= -for c:=bc to ec do -if (tag(c)=lig_tag) or (ctag(c)) then begin - r:=rremainder(c); - if (l_skip_byte(lig_step(r)) div 256)=0 then begin - if r<nl then begin - if l_skip_byte(lig_step(r))>stop_flag then begin - r:=256*l_op_byte(lig_step(r))+l_remainder(lig_step(r)); - if r<nl then if activity[rremainder(c)]=unreachable then - activity[rremainder(c)]:=pass_through; - end; - end; - end; - if r>=nl then begin - perfect:=false; print_ln(' '); - print('Ligature/kern starting index for character '); print_hex(c); - print_ln(' is too large;'); print_ln('so I removed it.'); set_no_tag(c); - set_no_ctag(c); -@.Ligature/kern starting index...@> - end - else @<Insert |(c,r)| into |label_table|@>; - end; -label_table[label_ptr+1].rr:=lig_size; {put ``infinite'' sentinel at the end} - -@ @<Insert |(c,r)|...@>= -begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|} -while label_table[sort_ptr].rr>r do begin - label_table[sort_ptr+1]:=label_table[sort_ptr]; - decr(sort_ptr); {move the hole} - end; -label_table[sort_ptr+1].ischar:=not ctag(c); -if ctag(c) then - label_table[sort_ptr+1].cc:=char_param(c,0) -else - label_table[sort_ptr+1].cc:=c; -label_table[sort_ptr+1].rr:=r; {fill the hole} -incr(label_ptr); activity[r]:=accessible; -end - -@ @<Check for a bound...@>= -if l_skip_byte(lig_step(0))=255 then begin - left; out('BOUNDARYCHAR'); - boundary_char:=l_next_char(lig_step(0)); out_char(boundary_char); right; - activity[0]:=pass_through; - end; -if l_skip_byte(lig_step(nl-1))=255 then begin - r:=256*l_op_byte(lig_step(nl-1))+l_remainder(lig_step(nl-1)); - if r>=nl then begin - perfect:=false; print_ln(' '); - print('Ligature/kern starting index for boundarychar is too large;'); - print_ln('so I removed it.'); -@.Ligature/kern starting index...@> - end - else begin - label_ptr:=1; label_table[1].cc:=xmax_char; - label_table[1].rr:=r; - bchar_label:=r; activity[r]:=accessible; - end; - activity[nl-1]:=pass_through; - end - -@ @<Compute the |activity| array@>= -for ai:=0 to (nl-1) do -if (l_skip_byte(lig_step(ai)) div 256)=1 then - activity[ai]:=accessible -else if activity[ai]=accessible then begin - r:=l_skip_byte(lig_step(ai)); - if r<stop_flag then begin - r:=r+ai+1; - if r>=nl then begin - bad('Ligature/kern step ',ai:1,' skips too far;'); -@.Lig...skips too far@> - print_ln('I made it stop.'); set_l_skip_byte(lig_step(ai),stop_flag); - end - else activity[r]:=accessible; - end; - end - -@ We ignore |pass_through| items, which don't need to be mentioned in -the \.{PL} file. - -@<Output and correct the ligature...@>= -sort_ptr:=1; {point to the next label that will be needed} -for acti:=0 to nl-1 do if activity[acti]<>pass_through then begin - i:=acti; @<Take care of commenting out unreachable steps@>; - @<Output any labels for step $i$@>; - @<Output step $i$ of the ligature/kern program@>; - end; -if level=2 then right {the final step was unreachable} - -@ @<Globals...@>= -@!output_clabels:array[0..256] of boolean; -@!clabel_runner:integer; -@!cprime:integer; - -@ @<Set init...@>= -for clabel_runner:=0 to 256 do - output_clabels[clabel_runner]:=false; - -@ @<Output any labels...@>= -while i=label_table[sort_ptr].rr do begin - if not label_table[sort_ptr].ischar then begin - if not output_clabels[label_table[sort_ptr].cc] then begin - output_clabels[label_table[sort_ptr].cc]:=true; - left; - out('CLABEL'); - out_char(label_table[sort_ptr].cc); - right; - end - end - else begin - left; - out('LABEL'); - if label_table[sort_ptr].cc=xmax_char then out(' BOUNDARYCHAR') - else out_char(label_table[sort_ptr].cc); - right; - end; - incr(sort_ptr); - end - -@ @<Take care of commenting out...@>= -if activity[i]=unreachable then begin - if level=1 then begin - left; out('COMMENT THIS PART OF THE PROGRAM IS NEVER USED!'); out_ln; - end - end -else if level=2 then right - -@ @<Output step $i$...@>= -begin k:=lig_step(i); -if (l_skip_byte(k) div 256)=1 then begin - case l_op_byte(k) of - 17: begin - left; out('CPEN'); - out_hex_number(l_next_char(k)); - out_hex_number(l_remainder(k)); - right; - end; - 18: begin - left; out('CGLUE'); - out_hex_number(l_next_char(k)); - out_hex_number(l_remainder(k)); - right; - end; - 19: begin - left; out('CPENGLUE'); - out_hex_number(l_next_char(k)); - out_hex_number(l_remainder(k) div 256); - out_hex_number(l_remainder(k) mod 256); - right; - end; - 20: begin - left; out('CKRN'); - out_hex_number(l_next_char(k)); - r:=l_remainder(k); - if r>=nk then begin - bad('Kern index too large.'); -@.Kern index too large@> - out(' R 0.0'); - end - else out_fix(kern(r)); - right; - end; - end; - end -else if l_skip_byte(k)>stop_flag then begin - if (256*l_op_byte(k)+l_remainder(k))>=nl then - bad('Ligature unconditional stop command address is too big.'); -@.Ligature unconditional stop...@> - end -else if l_op_byte(k)>=kern_flag then @<Output a kern step@> -else @<Output a ligature step@>; -if (l_skip_byte(k) mod 256)>0 then - if level=1 then @<Output either \.{SKIP} or \.{STOP}@>; -end - -@ The \.{SKIP} command is a bit tricky, because we will be omitting all -inaccessible commands. - -@<Output either...@>= -begin if (l_skip_byte(k) mod 256)>=stop_flag then out('(STOP)') -else begin - count:=0; - for ai:=(i+1) to (i+(l_skip_byte(k) mod 256)) do - if activity[ai]=accessible then incr(count); - out('(SKIP D ',count:1,')'); {possibly $count=0$, so who cares} - end; -out_ln; -end - -@ @<Output a kern step@>= -begin if nonexistent(l_next_char(k)) then - if l_next_char(k)<>boundary_char then - correct_bad_char('Kern step for')(l_next_char)(set_l_next_char); -@.Kern step for nonexistent...@> -left; out('KRN'); out_char(l_next_char(k)); -r:=256*(l_op_byte(k)-kern_flag)+l_remainder(k); -if r>=nk then begin - bad('Kern index too large.'); -@.Kern index too large@> - out(' R 0.0'); - end -else out_fix(kern(r)); -right; -end - -@ @<Output a ligature step@>= -begin if nonexistent(l_next_char(k)) then - if l_next_char(k)<>boundary_char then - correct_bad_char('Ligature step for')(l_next_char)(set_l_next_char); -@.Ligature step for nonexistent...@> -if nonexistent(l_remainder(k)) then -correct_bad_char('Ligature step produces the')(l_remainder)(set_l_remainder); -@.Ligature step produces...@> -left; r:=l_op_byte(k); -if (r=4)or((r>7)and(r<>11)) then begin - print_ln('Ligature step with nonstandard code changed to LIG'); - r:=0; set_l_op_byte(k,0); - end; -if r mod 4>1 then out('/'); -out('LIG'); -if odd(r) then out('/'); -while r>3 do begin - out('>'); r:=r-4; - end; -out_char(l_next_char(k)); out_char(l_remainder(k)); right; -end - -@ The last thing on \.{VFtoVP}'s agenda is to go through the -list of |char_info| and spew out the information about each individual -character. - -@<Do the characters@>= -sort_ptr:=0; {this will suppress `\.{STOP}' lines in ligature comments} -c:=bc; -while (c<=ec) do begin - if width_index(c)>0 then begin - if chars_on_line=8 then begin - print_ln(' '); chars_on_line:=1; - end - else begin - if chars_on_line>0 then print(' '); - incr(chars_on_line); - end; - for cprime:=c to (c+no_repeats(c)) do begin - print_hex(cprime); {progress report} - left; out('CHARACTER'); out_char(cprime); out_ln; - @<Output the character's width@>; - if height_index(c)>0 then @<Output the character's height@>; - if depth_index(c)>0 then @<Output the character's depth@>; - if italic_index(c)>0 then @<Output the italic correction@>; - case tag(c) of - no_tag: do_nothing; - lig_tag: @<Output the applicable part of the ligature/kern - program as a comment@>; - list_tag: @<Output the character link unless there is a problem@>; - ext_tag: @<Output an extensible character recipe@>; - end; {there are no other cases} - for i:=0 to npc-1 do begin - if char_param(c,i)<>0 then begin - left; - if i<nki then begin - out('CHARIVALUE'); out_hex_number(i); - end - else if i<(nki+nkf) then begin - out('CHARFVALUE'); out_hex_number(i-nki); - end - else if i<(nki+nkf+nkr) then begin - out('CHARRULE'); out_hex_number(i-nki-nkf); - end - else if i<(nki+nkf+nkr+nkg) then begin - out('CHARGLUE'); out_hex_number(i-nki-nkf-nkr); - end - else if i<(nki+nkf+nkr+nkg+nkp) then begin - out('CHARPENALTY'); out_hex_number(i-nki-nkf-nkr-nkg); - end; - out_hex_number(char_param(c,i)); - right; - end; - end; - if not do_map(cprime) then goto final_end; - right; - end; - end; - c:=c+1+no_repeats(c); - end - -@ @<Output the character's width@>= -if width_index(c)>=nw then range_error('Width') -@.Width index for char...@> -else begin left; out('CHARWD'); out_fix(width(c)); right; - end - -@ @<Output the character's height@>= -if height_index(c)>=nh then range_error('Height') -@.Height index for char...@> -else begin left; out('CHARHT'); out_fix(height(c)); right; - end - -@ @<Output the character's depth@>= -if depth_index(c)>=nd then range_error('Depth') -@.Depth index for char@> -else begin left; out('CHARDP'); out_fix(depth(c)); right; - end - -@ @<Output the italic correction@>= -if italic_index(c)>=ni then range_error('Italic correction') -@.Italic correction index for char...@> -else begin left; out('CHARIC'); out_fix(italic(c)); right; - end - -@ @<Output the applicable part of the ligature...@>= -begin left; out('COMMENT'); out_ln;@/ -i:=rremainder(c); r:=lig_step(i); -if (l_skip_byte(r) mod 256)>stop_flag -then i:=256*l_op_byte(r)+l_remainder(r); -repeat @<Output step...@>; -if (l_skip_byte(k) mod 256)>=stop_flag then i:=nl -else i:=i+1+(l_skip_byte(k) mod 256); -until i>=nl; -right; -end - -@ We want to make sure that there is no cycle of characters linked together -by |list_tag| entries, since such a cycle would get \TeX\ into an endless -loop. If such a cycle exists, the routine here detects it when processing -the largest character code in the cycle. - -@<Output the character link unless there is a problem@>= -begin r:=rremainder(c); -if nonexistent(r) then begin - bad_char('Character list link to')(r); set_no_tag(c); -@.Character list link...@> - end -else begin - while (r<c)and(tag(r)=list_tag) do r:=rremainder(r); - if r=c then begin - bad('Cycle in a character list!'); -@.Cycle in a character list@> - print('Character '); print_hex(c); - print_ln(' now ends the list.'); - set_no_tag(c); - end - else begin - left; out('NEXTLARGER'); out_char(rremainder(c)); - right; - end; - end; -end - -@ @<Output an extensible character recipe@>= -if rremainder(c)>=ne then begin - range_error('Extensible'); set_no_tag(c); -@.Extensible index for char@> - end -else begin - left; out('VARCHAR'); out_ln; - @<Output the extensible pieces that exist@>; - right; - end - -@ @<Glob...@>= -@!exten_char:integer; - -@ @<Output the extensible pieces that...@>= -for d:=0 to 3 do begin - if not ofm_on then begin - k:=exten(c)+d; - exten_char:=tfm[k]; - end - else begin - k:=exten(c)+2*d; - exten_char:=256*tfm[k]+tfm[k+1]; - end; - if (d=3)or(exten_char>0) then begin - left; - case d of - 0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end; - if nonexistent(exten_char) then out_char(c) - else out_char(exten_char); - right; - end - end - -@ Some of the extensible recipes may not actually be used, but \TeX\ will -complain about them anyway if they refer to nonexistent characters. -Therefore \.{VFtoVP} must check them too. - -@<Check the extensible recipes@>= -if ne>0 then - for c:=0 to ne-1 do - for d:=0 to 3 do begin - if not ofm_on then begin - k:=4*(exten_base+c)+d; - exten_char:=tfm[k]; - end - else begin - k:=4*(exten_base+c)+2*d; - exten_char:=256*tfm[k]+tfm[k+1]; - end; - if (exten_char>0)or(d=3) then begin - if nonexistent(exten_char) then begin - bad_char('Extensible recipe involves the')(exten_char); -@.Extensible recipe involves...@> - if d<3 then begin - if not ofm_on then begin - tfm[k]:=0; - end - else begin - tfm[k]:=0; - tfm[k+1]:=0; - end; - end; - end; - end; - end - -@* Checking for ligature loops. -We have programmed almost everything but the most interesting calculation of -all, which has been saved for last as a special treat. \TeX's extended -ligature mechanism allows unwary users to specify sequences of ligature -replacements that never terminate. For example, the pair of commands -$$\.{(/LIG $x$ $y$) (/LIG $y$ $x$)}$$ -alternately replaces character $x$ by character $y$ and vice versa. A similar -loop occurs if \.{(LIG/ $z$ $y$)} occurs in the program for $x$ and - \.{(LIG/ $z$ $x$)} occurs in the program for $y$. - -More complicated loops are also possible. For example, suppose the ligature -programs for $x$ and $y$ are -$$\vcenter{\halign{#\hfil\cr -\.{(LABEL $x$)(/LIG/ $z$ $w$)(/LIG/> $w$ $y$)} \dots,\cr -\.{(LABEL $y$)(LIG $w$ $x$)} \dots;\cr}}$$ -then the adjacent characters $xz$ change to $xwz$, $xywz$, $xxz$, $xxwz$, -\dots, ad infinitum. - -@ To detect such loops, \.{TFtoPL} attempts to evaluate the function -$f(x,y)$ for all character pairs $x$ and~$y$, where $f$ is defined as -follows: If the current character is $x$ and the next character is -$y$, we say the ``cursor'' is between $x$ and $y$; when the cursor -first moves past $y$, the character immediately to its left is -$f(x,y)$. This function is defined if and only if no infinite loop is -generated when the cursor is between $x$ and~$y$. - -The function $f(x,y)$ can be defined recursively. It turns out that all pairs -$(x,y)$ belong to one of five classes. The simplest class has $f(x,y)=y$; -this happens if there's no ligature between $x$ and $y$, or in the cases -\.{LIG/>} and \.{/LIG/>>}. Another simple class arises when there's a -\.{LIG} or \.{/LIG>} between $x$ and~$y$, generating the character~$z$; -then $f(x,y)=z$. Otherwise we always have $f(x,y)$ equal to -either $f(x,z)$ or $f(z,y)$ or $f(f(x,z),y)$, where $z$ is the inserted -ligature character. - -The first two of these classes can be merged; we can also consider -$(x,y)$ to belong to the simple class when $f(x,y)$ has been evaluated. -For technical reasons we allow $x$ to be 256 (for the boundary character -at the left) or 257 (in cases when an error has been detected). - -For each pair $(x,y)$ having a ligature program step, we store -$(x,y)$ in a hash table from which the values $z$ and $class$ can be read. - -@d simple=0 {$f(x,y)=z$} -@d left_z=1 {$f(x,y)=f(z,y)$} -@d right_z=2 {$f(x,y)=f(x,z)$} -@d both_z=3 {$f(x,y)=f(f(x,z),y)$} -@d pending=4 {$f(x,y)$ is being evaluated} - -@<Glob...@>= -@!hash:array[0..hash_size] of integer; -@!class:array[0..hash_size] of simple..pending; -@!lig_z:array[0..hash_size] of xxchar_type; -@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|} -@!hash_list:array[0..hash_size] of 0..hash_size; - {list of those nonzero entries} -@!h,@!hh:0..hash_size; {indices into the hash table} -@!x_lig_cycle,@!y_lig_cycle:xchar_type; {problematic ligature pair} - -@ @<Check for ligature cycles@>= -hash_ptr:=0; y_lig_cycle:=xmax_char; -for hh:=0 to hash_size do hash[hh]:=0; {clear the hash table} -for c:=bc to ec do if tag(c)=lig_tag then begin - i:=rremainder(c); - if (l_skip_byte(lig_step(i)) mod 256)>stop_flag then - i:=256*l_op_byte(lig_step(i))+l_remainder(lig_step(i)); - @<Enter data for character $c$ starting at location |i| in the hash table@>; - end; -if bchar_label<nl then begin - c:=xmax_char; i:=bchar_label; - @<Enter data for character $c$ starting at location |i| in the hash table@>; - end; -if hash_ptr=hash_size then begin - print_ln('Sorry, I haven''t room for so many ligature/kern pairs!'); -@.Sorry, I haven't room...@> - goto final_end; - end; -for hh:=1 to hash_ptr do begin - r:=hash_list[hh]; - if class[r]>simple then {make sure $f$ is defined} - r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char); - end; -if y_lig_cycle<xmax_char then begin - print('Infinite ligature loop starting with '); -@.Infinite ligature loop...@> - if x_lig_cycle=xmax_char - then print('boundary')@+else print_hex(x_lig_cycle); - print(' and '); print_hex(y_lig_cycle); print_ln('!'); - out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end; - end - -@ @<Enter data for character $c$...@>= -repeat hash_input; k:=l_skip_byte(lig_step(i)); -if k>=stop_flag then i:=nl -else i:=i+1+k; -until i>=nl - -@ We use an ``ordered hash table'' with linear probing, because such a table -is efficient when the lookup of a random key tends to be unsuccessful. - -@p procedure hash_input; {enter data for character |c| and command |i|} -label 30; {go here for a quick exit} -var @!cc:simple..both_z; {class of data being entered} -@!zz:char_type; {function value or ligature character being entered} -@!y:char_type; {the character after the cursor} -@!key:integer; {value to be stored in |hash|} -@!t:integer; {temporary register for swapping} -begin if hash_ptr=hash_size then goto 30; -@<Compute the command parameters |y|, |cc|, and |zz|@>; -key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size; -while hash[h]>0 do begin - if hash[h]<=key then begin - if hash[h]=key then goto 30; {unused ligature command} - t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion} - t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap} - t:=lig_z[h]; lig_z[h]:=zz; zz:=t; - end; - if h>0 then decr(h)@+else h:=hash_size; - end; -hash[h]:=key; class[h]:=cc; lig_z[h]:=zz; -incr(hash_ptr); hash_list[hash_ptr]:=h; -30:end; - -@ We must store kern commands as well as ligature commands, because -the former might make the latter inapplicable. - -@<Compute the command param...@>= -k:=lig_step(i); y:=l_next_char(k); t:=l_op_byte(k); -cc:=simple; zz:=l_remainder(k); -if t>=kern_flag then zz:=y -else begin case t of - 0,6:do_nothing; {\.{LIG},\.{/LIG>}} - 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}} - 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}} - 2:cc:=right_z; {\.{/LIG}} - 3:cc:=both_z; {\.{/LIG/}} - end; {there are no other cases} - end - -@ Evaluation of $f(x,y)$ is handled by two mutually recursive procedures. -Kind of a neat algorithm, generalizing a depth-first search. - -@p function f(@!h,@!x,@!y:index):index; forward;@t\2@> - {compute $f$ for arguments known to be in |hash[h]|} -function eval(@!x,@!y:index):index; {compute $f(x,y)$ with hashtable lookup} -var @!key:integer; {value sought in hash table} -begin key:=xmax_char*x+y+1; h:=(hash_mult*key) mod hash_size; -while hash[h]>key do - if h>0 then decr(h)@+else h:=hash_size; -if hash[h]<key then eval:=y {not in ordered hash table} -else eval:=f(h,x,y); -end; - -@ Pascal's beastly convention for |forward| declarations prevents us from -saying |function f(h,x,y:index):index| here. - -@p function f; -begin case class[h] of -simple: do_nothing; -left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple; - end; -right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple; - end; -both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y); - class[h]:=simple; - end; -pending: begin x_lig_cycle:=x; y_lig_cycle:=y; - lig_z[h]:=xxmax_char; class[h]:=simple; - end; {the value |xxmax_char| will break all cycles, - since it's not in |hash|} -end; {there are no other cases} -f:=lig_z[h]; -end; - -@* Outputting the VF info. -The routines we've used for output from the |tfm| array have counterparts -for output from |vf|. One difference is that the string outputs from |vf| -need to be checked for balanced parentheses. The |string_balance| routine -tests the string of length~|l| that starts at location~|k|. - -@p function string_balance(@!k,@!l:integer):boolean; -label not_found,exit; -var @!j,@!bal:integer; -begin if l>0 then if vf[k]=" " then goto not_found; - {a leading blank is considered unbalanced} -bal:=0; -for j:=k to k+l-1 do begin - if (vf[j]<" ")or(vf[j]>=127) then goto not_found; - if vf[j]="(" then incr(bal) - else if vf[j]=")" then - if bal=0 then goto not_found else decr(bal); - end; -if bal>0 then goto not_found; -string_balance:=true; return; -not_found:string_balance:=false; -exit:end; - -@ @d bad_vf(#)==begin perfect:=false; if chars_on_line>0 then print_ln(' '); - chars_on_line:=0; print_ln('Bad OVF file: ',#); - end -@.Bad OVF file@> - -@<Do the virtual font title@>= -if string_balance(0,font_start[0]) then begin - left; out('VTITLE '); - for k:=0 to font_start[0]-1 do out(xchr[vf[k]]); - right; - end -else bad_vf('Title is not a balanced ASCII string') -@.Title is not balanced@> - -@ We can re-use some code by moving |fix_word| data to |tfm|, using the -fact that the design size has already been output. - -@p procedure out_as_fix(@!x:integer); -var @!k:1..3; -begin if abs(x)>=@'100000000 then - bad_vf('Oversize dimension has been reset to zero.'); -@.Oversize dimension...@> -if x>=0 then tfm[design_size]:=0 -else begin - tfm[design_size]:=255; x:=x+@'100000000; - end; -for k:=3 downto 1 do begin - tfm[design_size+k]:=x mod 256; x:=x div 256; - end; -out_fix(design_size); -end; - -@ @<Do the local fonts@>= -for f:=0 to font_ptr-1 do begin - left; out('MAPFONT D ',f:1); out_ln; - @<Output the font area and name@>; - for k:=0 to 11 do tfm[k]:=vf[font_start[f]+k]; - if tfm[0]+tfm[1]+tfm[2]+tfm[3]>0 then begin - left; out('FONTCHECKSUM'); out_hex(0,4); right; - end; - left; out('FONTAT'); out_fix(4); right; - left; out('FONTDSIZE'); out_fix(8); right; right; - end - -@ @<Output the font area and name@>= -a:=vf[font_start[f]+12]; l:=vf[font_start[f]+13]; -if a>0 then - if not string_balance(font_start[f]+14,a) then - bad_vf('Improper font area will be ignored') -@.Improper font area@> - else begin - left; out('FONTAREA '); - for k:=font_start[f]+14 to font_start[f]+a+13 do out(xchr[vf[k]]); - right; - end; -if (l=0)or not string_balance(font_start[f]+14+a,l) then - bad_vf('Improper font name will be ignored') -@.Improper font name@> -else begin - left; out('FONTNAME '); - for k:=font_start[f]+14+a to font_start[f]+a+l+13 do out(xchr[vf[k]]); - right; - end - -@ Now we get to the interesting part of \.{VF} output, where \.{DVI} -commands are translated into symbolic form. The \.{VPL} language is a subset -of \.{DVI}, so we sometimes need to output semantic equivalents of -the commands instead of producing a literal translation. This causes a -small but tolerable loss of efficiency. We need to simulate the stack -used by \.{DVI}-reading software. - -@<Glob...@>= -@!top:0..max_stack; {\.{DVI} stack pointer} -@!wstack,@!xstack,@!ystack,@!zstack:array[0..max_stack] of integer; - {stacked values of \.{DVI} registers |w|, |x|, |y|, |z|} -@!vf_limit:0..vf_size; {the current packet ends here} -@!o:byte; {the current opcode} - -@ @<Do the packet for character |c|@>= -if packet_start[c]=vf_size then - bad_vf('Missing packet for character ',c:1) -@.Missing packet@> -else begin - left; out('MAP'); out_ln; - top:=0; wstack[0]:=0; xstack[0]:=0; ystack[0]:=0; zstack[0]:=0; - vf_ptr:=packet_start[c]; vf_limit:=packet_end[c]+1; f:=0; - while vf_ptr<vf_limit do begin - o:=vf[vf_ptr]; incr(vf_ptr); - case o of - @<Cases of \.{DVI} instructions that can appear in character packets@>@; - improper_DVI_for_VF: bad_vf('Illegal DVI code ',o:1,' will be ignored'); - end; {there are no other cases} - end; - if top>0 then begin - bad_vf('More pushes than pops!'); -@.More pushes than pops@> - repeat out('(POP)'); decr(top);@+until top=0; - end; - right; - end - -@ A procedure called |get_bytes| helps fetch the parameters of \.{DVI} commands. - -@p function get_bytes(@!k:integer;@!signed:boolean):integer; -var @!a:integer; {accumulator} -begin if vf_ptr+k>vf_limit then begin - bad_vf('Packet ended prematurely'); k:=vf_limit-vf_ptr; - end; -a:=vf[vf_ptr]; -if (k=4) or signed then - if a>=128 then a:=a-256; -incr(vf_ptr); -while k>1 do begin - a:=a*256+vf[vf_ptr]; incr(vf_ptr); decr(k); - end; -get_bytes:=a; -end; - -@ Let's look at the simplest cases first, in order to get some experience. - -@d four_cases(#)==#,#+1,#+2,#+3 -@d eight_cases(#)==four_cases(#),four_cases(#+4) -@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8) -@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16) -@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32) - -@<Cases...@>= -nop:do_nothing; -push:begin if top=max_stack then - begin print_ln('Stack overflow!'); goto final_end; -@.Stack overflow@> - end; - incr(top); wstack[top]:=wstack[top-1]; xstack[top]:=xstack[top-1]; - ystack[top]:=ystack[top-1]; zstack[top]:=zstack[top-1]; out('(PUSH)'); - out_ln; - end; -pop:if top=0 then bad_vf('More pops than pushes!') -@.More pops than pushes@> - else begin decr(top); out('(POP)'); out_ln; - end; -set_rule,put_rule:begin if o=put_rule then out('(PUSH)'); - left; out('SETRULE'); out_as_fix(get_bytes(4,true)); - out_as_fix(get_bytes(4,true)); - if o=put_rule then out(')(POP'); - right; - end; - -@ Horizontal and vertical motions become \.{RIGHT} and \.{DOWN} in \.{VPL} -lingo. - -@<Cases...@>= -four_cases(right1):begin out('(MOVERIGHT'); - out_as_fix(get_bytes(o-right1+1,true)); - out(')'); out_ln;@+end; -w0,four_cases(w1):begin if o<>w0 then wstack[top]:=get_bytes(o-w1+1,true); - out('(MOVERIGHT'); out_as_fix(wstack[top]); out(')'); out_ln;@+end; -x0,four_cases(x1):begin if o<>x0 then xstack[top]:=get_bytes(o-x1+1,true); - out('(MOVERIGHT'); out_as_fix(xstack[top]); out(')'); out_ln;@+end; -four_cases(down1):begin out('(MOVEDOWN'); out_as_fix(get_bytes(o-down1+1,true)); - out(')'); out_ln;@+end; -y0,four_cases(y1):begin if o<>y0 then ystack[top]:=get_bytes(o-y1+1,true); - out('(MOVEDOWN'); out_as_fix(ystack[top]); out(')'); out_ln;@+end; -z0,four_cases(z1):begin if o<>z0 then zstack[top]:=get_bytes(o-z1+1,true); - out('(MOVEDOWN'); out_as_fix(zstack[top]); out(')'); out_ln;@+end; - -@ Variable |f| always refers to the current font. If |f=font_ptr|, it's -a font that hasn't been defined (so its characters will be ignored). - -@<Cases...@>= -sixty_four_cases(fnt_num_0),four_cases(fnt1):begin f:=0; - if o>=fnt1 then font_number[font_ptr]:=get_bytes(o-fnt1+1,false) - else font_number[font_ptr]:=o-fnt_num_0; - while font_number[f]<>font_number[font_ptr] do incr(f); - if f=font_ptr then bad_vf('Undeclared font selected') -@.Undeclared font selected@> - else begin out('(SELECTFONT D ',f:1,')'); out_ln; - end; - end; - -@ Before we typeset a character we make sure that it exists. - -@<Cases...@>= -sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64), - four_cases(set1),four_cases(put1):begin if o>=set1 then - if o>=put1 then c:=get_bytes(o-put1+1,false) - else c:=get_bytes(o-set1+1,false) - else c:=o; - if f=font_ptr then - bad_vf('Character ',c:1,' in undeclared font will be ignored') -@.Character...will be ignored@> - else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left} - k:=font_chars[f];@+while vf[k]<>c do incr(k); - if k=font_start[f+1]-1 then - bad_vf('Character ',c:1,' in font ',f:1,' will be ignored') - else begin if o>=put1 then out('(PUSH)'); - left; out('SETCHAR'); out_char(c); - if o>=put1 then out(')(POP'); - right; - end; - end; - end; - -@ The ``special'' commands are the only ones remaining to be dealt with. -We use a hexadecimal -output in the general case, if a simple string would be inadequate. - -@d vf_out_hex(#)==begin a:=#; - if a<10 then out(a:1) - else out(xchr[a-10+"A"]); - end - -@<Cases...@>= -four_cases(xxx1):begin k:=get_bytes(o-xxx1+1,false); - if k<0 then bad_vf('String of negative length!') - else begin left; - if k+vf_ptr>vf_limit then - begin bad_vf('Special command truncated to packet length'); - k:=vf_limit-vf_ptr; - end; - if (k>64)or not string_balance(vf_ptr,k) then - begin out('SPECIALHEX '); - while k>0 do - begin if k mod 32=0 then out_ln - else if k mod 4=0 then out(' '); - vf_out_hex(vf[vf_ptr] div 16); vf_out_hex(vf[vf_ptr] mod 16); - incr(vf_ptr); decr(k); - end; - end - else begin out('SPECIAL '); - while k>0 do - begin out(xchr[vf[vf_ptr]]); incr(vf_ptr); decr(k); - end; - end; - right; - end; - end; - -@* The main program. -The routines sketched out so far need to be packaged into separate procedures, -on some systems, since some \PASCAL\ compilers place a strict limit on the -size of a routine. The packaging is done here in an attempt to avoid some -system-dependent changes. - -First come the |vf_input| and |organize| procedures, which read the input data -and get ready for subsequent events. If something goes wrong, the routines -return |false|. - -@p function vf_input:boolean; -label final_end, exit; -var vf_ptr:0..vf_size; {an index into |vf|} -@!k:integer; {all-purpose index} -@!c:integer; {character code} -begin @<Read the whole \.{VF} file@>; -vf_input:=true; return; -final_end: vf_input:=false; -exit: end; -@# -function organize:boolean; -label final_end, exit; -var tfm_ptr:index; {an index into |tfm|} -begin @<Read the whole font metric file@>; -@<Set subfile sizes |lh|, |bc|, \dots, |np|@>; -@<Compute the base addresses@>; -organize:=vf_input; return; -final_end: organize:=false; -exit: end; - -@ Next we do the simple things. - -@p procedure do_simple_things; -var i:0..@'77777; {an index to words of a subfile} -@!f:0..vf_size; {local font number} -@!k:integer; {all-purpose index} -begin @<Do the virtual font title@>; -@<Do the header@>; -@<Do the parameters@>; -@<Do the ivalue parameters@>;@/ -@<Do the fvalue parameters@>;@/ -@<Do the rule parameters@>;@/ -@<Do the glue parameters@>;@/ -@<Do the penalty parameters@>;@/ -@<Do the local fonts@>; -@<Check the |fix_word| entries@>; -end; - -@ And then there's a routine for individual characters. - -@p function do_map(@!c:integer):boolean; -label final_end,exit; -var @!k:integer; -@!f:0..vf_size; {current font number} -begin @<Do the packet for character |c|@>; -do_map:=true; return; -final_end: do_map:=false; -exit:end; -@# -function do_characters:boolean; -label final_end, exit; -var @!c:integer; {character being done} -@!k:index; {a random index} -@!ai:0..lig_size; {index into |activity|} -begin @<Do the characters@>;@/ -do_characters:=true; return; -final_end: do_characters:=false; -exit:end; - -@ Here is where \.{VFtoVP} begins and ends. -@p begin initialize;@/ -if not organize then goto final_end; -do_simple_things;@/ -@<Do the ligatures and kerns@>; -@<Check the extensible recipes@>; -if not do_characters then goto final_end; -print_ln('.');@/ -if level<>0 then print_ln('This program isn''t working!'); -@.This program isn't working@> -if not perfect then begin - out('(COMMENT THE OFM AND/OR OVF FILE WAS BAD, '); - out('SO THE DATA HAS BEEN CHANGED!)'); - end; -@.THE OFM AND/OR OVF FILE WAS BAD...@> -final_end:end. - -@* System-dependent changes. -This section should be replaced, if necessary, by changes to the program -that are necessary to make \.{VFtoVP} 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 printed 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@> - -@* Index. -Pointers to error messages appear here together with the section numbers -where each ident\-i\-fier is used. diff --git a/Build/source/texk/web2c/omegaware/ovp2ovf.ch b/Build/source/texk/web2c/omegaware/ovp2ovf.ch deleted file mode 100644 index 058f755c138..00000000000 --- a/Build/source/texk/web2c/omegaware/ovp2ovf.ch +++ /dev/null @@ -1,320 +0,0 @@ -% -% This file is part of the Omega project, which -% is based in the web2c distribution of TeX. -% -% Copyright (c) 1994--1998 John Plaice and Yannis Haralambous -% applies only to the changes to the original vptovf.ch. -% -% vptovf.ch for C compilation with web2c. - -@x [0] WEAVE: print changes only. -\pageno=\contentspagenumber \advance\pageno by 1 -@y -\pageno=\contentspagenumber \advance\pageno by 1 -%\let\maybe=\iffalse -%\def\title{OVP2OVF changes for C} -@z - -@x [2] Print the banner later. -procedure initialize; {this procedure gets things started properly} - var @<Local variables for initialization@>@/ - begin print_ln(banner);@/ -@y -@<Define |parse_arguments|@> -procedure initialize; {this procedure gets things started properly} - var @<Local variables for initialization@>@/ - begin - kpse_set_progname (argv[0]); - parse_arguments; -@z - -@x [3] Increase constants. -@!buf_size=60; {length of lines displayed in error messages} -@y -@!buf_size=3000; {max input line length, output error line length} -@z -%@x -%@!vf_size=10000; {maximum length of |vf| data, in bytes} -%@!max_stack=100; {maximum depth of simulated \.{DVI} stack} -%@!max_param_words=30; {the maximum number of \.{fontdimen} parameters allowed} -%@!max_lig_steps=5000; -% {maximum length of ligature program, must be at most $32767-257=32510$} -%@!max_kerns=500; {the maximum number of distinct kern values} -%@!hash_size=5003; {preferably a prime number, a bit larger than the number -% of character pairs in lig/kern steps} -%@y -%@!vf_size=50000; {maximum length of |vf| data, in bytes} -%@!max_stack=100; {maximum depth of simulated \.{DVI} stack} -%@!max_param_words=30; {the maximum number of \.{fontdimen} parameters allowed} -%@!max_lig_steps=10000; -% {maximum length of ligature program, must be at most $32767-257=32510$} -%@!max_kerns=10000; {the maximum number of distinct kern values} -%@!hash_size=10007; {preferably a prime number, a bit larger than the number -% of character pairs in lig/kern steps} -%@z - -@x [6] Open VPL file. -reset(vpl_file); -@y -reset (vpl_file, vpl_name); -if verbose then begin - print (banner); - print_ln (banner); -end; -@z - -@x [22] Open output files. -@ On some systems you may have to do something special to write a -packed file of bytes. For example, the following code didn't work -when it was first tried at Stanford, because packed files have to be -opened with a special switch setting on the \PASCAL\ that was used. -@^system dependencies@> - -@<Set init...@>= -rewrite(vf_file); rewrite(tfm_file); -@y -@ On some systems you may have to do something special to write a -packed file of bytes. -@^system dependencies@> - -@<Set init...@>= -rewritebin (vf_file, vf_name); -rewritebin (tfm_file, tfm_name); -@z - -% [89] `index' is not a good choice for an identifier on Unix systems. -% Neither is `class', on AIX. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x -|k|th element of its list. -@y -|k|th element of its list. - -@d index == index_var -@d class == class_var -@z - -@x [118] No output unless verbose. -@<Print |c| in hex notation@>; -@y -if verbose then @<Print |c| in hex notation@>; -@z - -@x -@!HEX: packed array [1..32] of char; -@y -@!HEX: c_string; -@z - -@x -HEX:='0123456789ABCDEF';@/ -@y -HEX:=' 0123456789ABCDEF';@/ -@z - -@x [144] Output of real numbers. -@ @d round_message(#)==if delta>0 then print_ln('I had to round some ', -@.I had to round...@> - #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.') -@y -@ @d round_message(#)==if delta>0 then begin print('I had to round some ', -@.I had to round...@> - #,'s by '); print_real((((delta+1) div 2)/@'4000000),1,7); - print_ln(' units.'); end -@z - -@x [152] Fix up the mutually recursive procedures a la pltotf. -@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@> - {compute $f$ for arguments known to be in |hash[h]|} -@y -@p -ifdef('notdef') -function f(@!h,@!x,@!y:indx):indx; begin end;@t\2@> - {compute $f$ for arguments known to be in |hash[h]|} -endif('notdef') -@z - -@x [153] Finish fixing up f. -@p function f; -@y -@p function f(@!h,@!x,@!y:indx):indx; -@z - -@x [156] Change TFM-byte output to fix ranges. -@d out(#)==write(tfm_file,#) -@y -@d out(#)==putbyte(#,tfm_file) -@z - -@x [165] Fix output of reals. -@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|} -var @!n:byte; {the first byte after the sign} -@!m:0..65535; {the two least significant bytes} -begin if abs(x/design_units)>=16.0 then begin - print_ln('The relative dimension ',x/@'4000000:1:3, - ' is too large.'); -@.The relative dimension...@> - print(' (Must be less than 16*designsize'); - if design_units<>unity then print(' =',design_units/@'200000:1:3, - ' designunits'); -@y -@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|} -var @!n:byte; {the first byte after the sign} -@!m:0..65535; {the two least significant bytes} -begin if fabs(x/design_units)>=16.0 then begin - print('The relative dimension '); - print_real(x/@'4000000,1,3); - print_ln(' is too large.'); -@.The relative dimension...@> - print(' (Must be less than 16*designsize'); - if design_units<>unity then begin print(' ='); - print_real(design_units/@'200000,1,3); - print(' designunits'); - end; -@z - -% [141] char_remainder[c] is unsigned, and label_table[sort_ptr].rr -% might be -1, and if -1 is coerced to being unsigned, it will be bigger -% than anything else. -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -@x - while label_table[sort_ptr].rr>char_remainder[c] do begin -@y - while label_table[sort_ptr].rr>intcast(char_remainder[c]) do begin -@z - -@x [175] Change VF-byte output to fix ranges. -@d vout(#)==write(vf_file,#) -@y -@d vout(#)==putbyte(#,vf_file) -@z - -@x [181] Be quiet unless verbose. -read_input; print_ln('.');@/ -@y -read_input; -if verbose then print_ln('.'); -@z - -@x [182] System-dependent changes. -This section should be replaced, if necessary, by changes to the program -that are necessary to make \.{VPtoVF} 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 printed 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@> -@y -Parse a Unix-style command line. - -@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0) - -@<Define |parse_arguments|@> = -procedure parse_arguments; -const n_options = 3; {Pascal won't count array lengths for us.} -var @!long_options: array[0..n_options] of getopt_struct; - @!getopt_return_val: integer; - @!option_index: c_int_type; - @!current_option: 0..n_options; -begin - @<Initialize the option variables@>; - @<Define the option table@>; - repeat - getopt_return_val := getopt_long_only (argc, argv, '', long_options, - address_of (option_index)); - if getopt_return_val = -1 then begin - {End of arguments; we exit the loop below.} ; - - end else if getopt_return_val = "?" then begin - usage ('ovp2ovf'); {|getopt| has already given an error message.} - - end else if argument_is ('help') then begin - usage_help (OVP2OVF_HELP, nil); - - end else if argument_is ('version') then begin - print_version_and_exit - (banner, nil, 'J. Plaice, Y. Haralambous, D.E. Knuth', nil); - - end; {Else it was a flag; |getopt| has already done the assignment.} - until getopt_return_val = -1; - - {Now |optind| is the index of first non-option on the command line. - We must have one to three remaining arguments.} - if (optind + 1 <> argc) and (optind + 2 <> argc) - and (optind + 3 <> argc) then begin - write_ln (stderr, 'ovp2ovf: Need one to three file arguments.'); - usage ('ovp2ovf'); - end; - - vpl_name := extend_filename (cmdline (optind), 'ovp'); - - if optind + 2 <= argc then begin - {Specified one or both of the output files.} - vf_name := extend_filename (cmdline (optind + 1), 'ovf'); - if optind + 3 <= argc then begin {Both.} - tfm_name := extend_filename (cmdline (optind + 2), 'ofm'); - end else begin {Just one.} - tfm_name := extend_filename (cmdline (optind + 1), 'ofm'); - end; - end else begin {Neither.} - vf_name := basename_change_suffix (vpl_name, '.ovp', '.ovf'); - tfm_name := basename_change_suffix (vpl_name, '.ovp', '.ofm'); - end; -end; - -@ Here are the options we allow. The first is one of the standard GNU options. -@.-help@> - -@<Define the option...@> = -current_option := 0; -long_options[current_option].name := 'help'; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; -incr (current_option); - -@ Another of the standard options. -@.-version@> - -@<Define the option...@> = -long_options[current_option].name := 'version'; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; -incr (current_option); - -@ Print progress information? -@.-verbose@> - -@<Define the option...@> = -long_options[current_option].name := 'verbose'; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := address_of (verbose); -long_options[current_option].val := 1; -incr (current_option); - -@ The global variable |verbose| determines whether or not we print -progress information. - -@<Glob...@> = -@!verbose: c_int_type; - -@ It starts off |false|. - -@<Initialize the option...@> = -verbose := false; - -@ An element with all zeros always ends the list. - -@<Define the option...@> = -long_options[current_option].name := 0; -long_options[current_option].has_arg := 0; -long_options[current_option].flag := 0; -long_options[current_option].val := 0; - -@ Global filenames. - -@<Global...@> = -@!vpl_name, @!tfm_name, @!vf_name:c_string; -@z diff --git a/Build/source/texk/web2c/omegaware/ovp2ovf.web b/Build/source/texk/web2c/omegaware/ovp2ovf.web deleted file mode 100644 index 0b6a6a329a7..00000000000 --- a/Build/source/texk/web2c/omegaware/ovp2ovf.web +++ /dev/null @@ -1,5071 +0,0 @@ -% -% This file is part of the Omega project, which -% is based in the web2c distribution of TeX. -% -% Copyright (c) 1994--2000 John Plaice and Yannis Haralambous -% applies only to the changes to the original vptovf.web. -% -% This program by D. E. Knuth is not copyrighted and can be used freely. -% Version 1 was implemented in December 1989. -% Version 1.1 fixed some for-loop indices for stricter Pascal (April 1990). -% Version 1.2 fixed `nonexistent char 0' bug, and a bit more (September 1990). -% Version 1.3 has more robust `out_scaled' (March 1991). -% Version 1.4 (March 1995) initialized lk_step_ended (Armin K\"ollner). - -% Here is TeX material that gets inserted after \input webmac -\def\hang{\hangindent 3em\indent\ignorespaces} -\font\ninerm=cmr9 -\let\mc=\ninerm % medium caps for names like SAIL -\def\PASCAL{Pascal} -\font\logo=logo10 % for the METAFONT logo -\def\MF{{\logo METAFONT}} - -\def\(#1){} % this is used to make section names sort themselves better -\def\9#1{} % this is used for sort keys in the index - -\def\title{OVP2OVF} -\def\contentspagenumber{201} -\def\topofcontents{\null - \def\titlepage{F} % include headline on the contents page - \def\rheader{\mainfont\hfil \contentspagenumber} - \vfill - \centerline{\titlefont The {\ttitlefont OVP2OVF} processor} - \vskip 15pt - \centerline{(Version 1.11, February 2000)} - \vfill} -\def\botofcontents{\vfill - \centerline{\hsize 5in\baselineskip9pt - \vbox{\ninerm\noindent - The preparation of this program - was supported in part by the National Science - Foundation and by the System Development Foundation. `\TeX' is a - trademark of the American Mathematical Society.}}} -\pageno=\contentspagenumber \advance\pageno by 1 - -@* Introduction. -The \.{OVP2OVF} utility program converts virtual-property-list (``\.{VPL}'' -and ``\.{OVP}'') files into an equivalent pair of files called a virtual -font (``\.{OVF}'') file and an $\Omega$ font metric (``\.{OFM}'') file. -It also makes a thorough check of the given \.{VPL} or \.{OVP} file, -so that the \.{OVF} file should be acceptable to device drivers and -the \.{OFM} file should be acceptable to $\Omega$. - -In the following documentation, all unchanged references to -the \.{VPtoVF} program and to \.{VPL}, \.{VF} and \.{TFM} files also apply to -the \.{OVP2OVF} program and to \.{OVP}, \.{OVF} and \.{OFM} files. - -\indent\.{VPtoVF} is an extended version of the program \.{PLtoTF}, which -is part of the standard \TeX ware library. -\.{OVP2OVF} is an extended version of \.{VPtoVF} that allows -much larger fonts. -The idea of a virtual font was inspired by the work of David R. Fuchs -@^Fuchs, David Raymond@> -who designed a similar set of conventions in 1984 while developing a -device driver for ArborText, Inc. He wrote a somewhat similar program -called \.{PLFONT}. - -The |banner| string defined here should be changed whenever \.{OVP2OVF} -gets modified. - -@d banner=='This is OVP2OVF, Version 1.11' -{printed when the program starts} - -@ This program is written entirely in standard \PASCAL, except that -it has to do some slightly system-dependent character code conversion -on input. Furthermore, lower case letters are used in error messages; -they could be converted to upper case if necessary. The input is read -from |vpl_file|, and the output is written on |vf_file| and |tfm_file|; -error messages and -other remarks are written on the |output| file, which the user may -choose to assign to the terminal if the system permits it. -@^system dependencies@> - -The term |print| is used instead of |write| when this program writes on -the |output| file, so that all such output can be easily deflected. - -@d print(#)==write(#) -@d print_ln(#)==write_ln(#) - -@p program OVP2OVF(@!vpl_file,@!vf_file,@!tfm_file,@!output); -const @<Constants in the outer block@>@/ -type @<Types in the outer block@>@/ -var @<Globals in the outer block@>@/ -procedure initialize; {this procedure gets things started properly} - var @<Local variables for initialization@>@/ - begin print_ln(banner);@/ - @<Set initial values@>@/ - end; - -@ The following parameters can be changed at compile time to extend or -reduce \.{VPtoVF}'s capacity. - -@<Constants...@>= -@!ofm_type=0; {16-bit OFM; sufficient for most purposes} -@!max_char=65535; {the largest character number in a font} -@!xmax_char=65536; {|max_char|+1} -@!xxmax_char=65537;{|max_char|+2} -@!mem_size=262148; {|max_char|*4+8} -@!max_font=1000; {the largest font number} -@!xmax_font=1001; {|max_font|+1} -@!xxmax_font=1002; {|max_font|+2} -@!max_width=65535; {the largest character width number} -@!max_height=255; {the largest character height number} -@!max_depth=255; {the largest character depth number} -@!max_italic=255; {the largest character italic correction number} -@!buf_size=60; {length of lines displayed in error messages} -@!max_header_bytes=100; {four times the maximum number of words allowed in - the \.{TFM} file header block, must be 1024 or less} -@!vf_size=200000; {maximum length of |vf| data, in bytes} -@!max_stack=100; {maximum depth of simulated \.{DVI} stack} -@!max_param_words=100; {the maximum number of \.{fontdimen} parameters allowed} -@!max_lig_steps=800000; {maximum length of ligature program} -@!xmax_label=800001; {must be greater than |max_lig_steps|} -@!hash_size=130003; {preferably a prime number, - a bit larger than |max_lig_steps|, the number - of character pairs in lig/kern steps} -@!hash_mult=16007; {another prime} -@!max_kerns=100000; {the maximum number of distinct kern values} - -@ Here are some macros for common programming idioms. - -@d incr(#) == #:=#+1 {increase a variable by unity} -@d decr(#) == #:=#-1 {decrease a variable by unity} -@d do_nothing == {empty statement} - -@* Property list description of font metric data. -The idea behind \.{VPL} files is that precise details about fonts, i.e., the -facts that are needed by typesetting routines like \TeX, sometimes have to -be supplied by hand. The nested property-list format provides a reasonably -convenient way to do this. - -A good deal of computation is necessary to parse and process a -\.{VPL} file, so it would be inappropriate for \TeX\ itself to do this -every time it loads a font. \TeX\ deals only with the compact descriptions -of font metric data that appear in \.{TFM} files. Such data is so compact, -however, it is almost impossible for anybody but a computer to read it. - -Device drivers also need a compact way to describe mappings from \TeX's idea -of a font to the actual characters a device can produce. They can do this -conveniently when given a packed sequence of bytes called a \.{VF} file. - -The purpose of \.{VPtoVF} is to convert from a human-oriented file of text -to computer-oriented files of binary numbers. There's a companion program, -\.{VFtoVP}, which goes the other way. - -@<Glob...@>= -@!vpl_file:text; - -@ @<Set init...@>= -reset(vpl_file); - -@ A \.{VPL} file is like a \.{PL} file with a few extra features, so we -can begin to define it by reviewing the definition of \.{PL} files. The -material in the next few sections is copied from the program \.{PLtoTF}. -An \.{OVP} file is simply a \.{VPL} file that does not restrict fonts -to 256 characters. - -A \.{PL} file is a list of entries of the form -$$\.{(PROPERTYNAME VALUE)}$$ -where the property name is one of a finite set of names understood by -this program, and the value may itself in turn be a property list. -The idea is best understood by looking at an example, so let's consider -a fragment of the \.{PL} file for a hypothetical font. -$$\vbox{\halign{\.{#}\hfil\cr -(FAMILY NOVA)\cr -(FACE F MIE)\cr -(CODINGSCHEME ASCII)\cr -(DESIGNSIZE D 10)\cr -(DESIGNUNITS D 18)\cr -(COMMENT A COMMENT IS IGNORED)\cr -(COMMENT (EXCEPT THIS ONE ISN'T))\cr -(COMMENT (ACTUALLY IT IS, EVEN THOUGH\cr -\qquad\qquad IT SAYS IT ISN'T))\cr -(FONTDIMEN\cr -\qquad (SLANT R -.25)\cr -\qquad (SPACE D 6)\cr -\qquad (SHRINK D 2)\cr -\qquad (STRETCH D 3)\cr -\qquad (XHEIGHT R 10.55)\cr -\qquad (QUAD D 18)\cr -\qquad )\cr -(LIGTABLE\cr -\qquad (LABEL C f)\cr -\qquad (LIG C f O 200)\cr -\qquad (SKIP D 1)\cr -\qquad (LABEL O 200)\cr -\qquad (LIG C i O 201)\cr -\qquad (KRN O 51 R 1.5)\cr -\qquad (/LIG C ? C f)\cr -\qquad (STOP)\cr -\qquad )\cr -(CHARACTER C f\cr -\qquad (CHARWD D 6)\cr -\qquad (CHARHT R 13.5)\cr -\qquad (CHARIC R 1.5)\cr -\qquad )\cr}}$$ -This example says that the font whose metric information is being described -belongs to the hypothetical -\.{NOVA} family; its face code is medium italic extended; -and the characters appear in ASCII code positions. The design size is 10 points, -and all other sizes in this \.{PL} file are given in units such that 18 units -equals the design size. The font is slanted with a slope of $-.25$ (hence the -letters actually slant backward---perhaps that is why the family name is -\.{NOVA}). The normal space between words is 6 units (i.e., one third of -the 18-unit design size), with glue that shrinks by 2 units or stretches by 3. -The letters for which accents don't need to be raised or lowered are 10.55 -units high, and one em equals 18 units. - -The example ligature table is a bit trickier. It specifies that the -letter \.f followed by another \.f is changed to code @'200, while -code @'200 followed by \.i is changed to @'201; presumably codes @'200 -and @'201 represent the ligatures `ff' and `ffi'. Moreover, in both cases -\.f and @'200, if the following character is the code @'51 (which is a -right parenthesis), an additional 1.5 units of space should be inserted -before the @'51. (The `\.{SKIP}~\.D~\.1' skips over one \.{LIG} or -\.{KRN} command, which in this case is the second \.{LIG}; in this way -two different ligature/kern programs can come together.) -Finally, if either \.f or @'200 is followed by a question mark, -the question mark is replaced by \.f and the ligature program is -started over. (Thus, the character pair `\.{f?}' would actually become -the ligature `ff', and `\.{ff?}' or `\.{f?f}' would become `fff'. To -avoid this restart procedure, the \.{/LIG} command could be replaced -by \.{/LIG>}; then `\.{f?} would become `f\kern0ptf' and `\.{f?f}' -would become `f\kern0ptff'.) - -Character \.f itself is 6 units wide and 13.5 units tall, in this example. -Its depth is zero (since \.{CHARDP} is not given), and its italic correction -is 1.5 units. - -@ The example above illustrates most of the features found in \.{PL} files. -Note that some property names, like \.{FAMILY} or \.{COMMENT}, take a -string as their value; this string continues until the first unmatched -right parenthesis. But most property names, like \.{DESIGNSIZE} and \.{SLANT} -and \.{LABEL}, take a number as their value. This number can be expressed in -a variety of ways, indicated by a prefixed code; \.D stands for decimal, -\.H for hexadecimal, \.O for octal, \.R for real, \.C for character, and -\.F for ``face.'' Other property names, like \.{LIG}, take two numbers as -their value. And still other names, like \.{FONTDIMEN} and \.{LIGTABLE} and -\.{CHARACTER}, have more complicated values that involve property lists. - -A property name is supposed to be used only in an appropriate property -list. For example, \.{CHARWD} shouldn't occur on the outer level or -within \.{FONTDIMEN}. - -The individual property-and-value pairs in a property list can appear in -any order. For instance, `\.{SHRINK}' precedes `\.{STRETCH}' in the above -example, although the \.{TFM} file always puts the stretch parameter first. -One could even give the information about characters like `\.f' before -specifying the number of units in the design size, or before specifying the -ligature and kerning table. However, the \.{LIGTABLE} itself is an exception -to this rule; the individual elements of the \.{LIGTABLE} property list -can be reordered only to a certain extent without changing the meaning -of that table. - -If property-and-value pairs are omitted, a default value is used. For example, -we have already noted that the default for \.{CHARDP} is zero. The default -for {\sl every\/} numeric value is, in fact, zero, unless otherwise stated -below. - -If the same property name is used more than once, \.{VPtoVF} will not notice -the discrepancy; it simply uses the final value given. Once again, however, the -\.{LIGTABLE} is an exception to this rule; \.{VPtoVF} will complain if there -is more than one label for some character. And of course many of the -entries in the \.{LIGTABLE} property list have the same property name. - -@ A \.{VPL} file also includes information about how to create each character, -by typesetting characters from other fonts and/or by drawing lines, etc. -Such information is the value of the `\.{MAP}' property, which can be -illustrated as follows: -$$\vbox{\halign{\.{#}\hfil\cr -(MAPFONT D 0 (FONTNAME Times-Roman))\cr -(MAPFONT D 1 (FONTNAME Symbol))\cr -(MAPFONT D 2 (FONTNAME cmr10)(FONTAT D 20))\cr -(CHARACTER O 0 (MAP (SELECTFONT D 1)(SETCHAR C G)))\cr -(CHARACTER O 76 (MAP (SETCHAR O 277)))\cr -(CHARACTER D 197 (MAP\cr -\qquad(PUSH)(SETCHAR C A)(POP)\cr -\qquad(MOVEUP R 0.937)(MOVERIGHT R 1.5)(SETCHAR O 312)))\cr -(CHARACTER O 200 (MAP (MOVEDOWN R 2.1)(SETRULE R 1 R 8)))\cr -(CHARACTER O 201 (MAP\cr -\qquad (SPECIAL ps: /SaveGray currentgray def .5 setgray)\cr -\qquad (SELECTFONT D 2)(SETCHAR C A)\cr -\qquad (SPECIAL ps: SaveGray setgray)))\cr -}}$$ -(These specifications appear in addition to the conventional \.{PL} -information. The \.{MAP} attribute can be mixed in with other attributes -like \.{CHARWD} or it can be given separately.) - -In this example, the virtual font is composed of characters that can be -fabricated from three actual fonts, `\.{Times-Roman}', -`\.{Symbol}', and `\.{cmr10} \.{at} \.{20\\u}' (where \.{\\u} -is the unit size in this \.{VPL} file). Character |@'0| is typeset as -a `G' from the symbol font. Character |@'76| is typeset as character |@'277| -from the ordinary Times font. (If no other font is selected, font -number~0 is the default. If no \.{MAP} attribute is given, the default map -is a character of the same number in the default font.) - -Character 197 (decimal) is more interesting: First an A is typeset (in the -default font Times), and this is enclosed by \.{PUSH} and \.{POP} so that -the original position is restored. Then the accent character |@'312| is -typeset, after moving up .937 units and right 1.5 units. - -To typeset character |@'200| in this virtual font, we move down 2.1 units, -then typeset a rule that is 1 unit high and 8 units wide. - -Finally, to typeset character |@'201|, we do something that requires a -special ability to interpret PostScript commands; this example -sets the PostScript ``color'' to 50\char`\%\ gray and typesets an `A' -from \.{cmr10} in that color. - -In general, the \.{MAP} attribute of a virtual character can be any sequence -of typesetting commands that might appear in a page of a \.{DVI} file. -A single character might map into an entire page. - -@ But instead of relying on a hypothetical example, let's consider a complete -grammar for \.{VPL} files, beginning with the (unchanged) grammatical rules -for \.{PL} files. At the outer level, the following property names -are valid in any \.{PL} file: - -\yskip\hang\.{CHECKSUM} (four-byte value). The value, which should be a -nonnegative integer less than $2^{32}$, is used to identify a particular -version of a font; it should match the check sum value stored with the font -itself. An explicit check sum of zero is used to bypass -check sum testing. If no checksum is specified in the \.{VPL} file, -\.{VPtoVF} will compute the checksum that \MF\ would compute from the -same data. - -\yskip\hang\.{DESIGNSIZE} (numeric value, default is 10). The value, which -should be a real number in the range |1.0<=x<2048|, represents the default -amount by which all quantities will be scaled if the font is not loaded -with an `\.{at}' specification. For example, if one says -`\.{\\font\\A=cmr10 at 15pt}' in \TeX\ language, the design size in the \.{TFM} -file is ignored and effectively replaced by 15 points; but if one simply -says `\.{\\font\\A=cmr10}' the stated design size is used. This quantity is -always in units of printer's points. - -\yskip\hang\.{DESIGNUNITS} (numeric value, default is 1). The value -should be a positive real number; it says how many units equals the design -size (or the eventual `\.{at}' size, if the font is being scaled). For -example, suppose you have a font that has been digitized with 600 pixels per -em, and the design size is one em; then you could say `\.{(DESIGNUNITS R 600)}' -if you wanted to give all of your measurements in units of pixels. - -\yskip\hang\.{CODINGSCHEME} (string value, default is `\.{UNSPECIFIED}'). -The string should not contain parentheses, and its length must be less than 40. -It identifies the correspondence between the numeric codes and font characters. -(\TeX\ ignores this information, but other software programs make use of it.) - -\yskip\hang\.{FAMILY} (string value, default is `\.{UNSPECIFIED}'). -The string should not contain parentheses, and its length must be less than 20. -It identifies the name of the family to which this font belongs, e.g., -`\.{HELVETICA}'. (\TeX\ ignores this information; but it is needed, for -example, when converting \.{DVI} files to \.{PRESS} files for Xerox -equipment.) - -\yskip\hang\.{FACE} (one-byte value). This number, which must lie between -0 and 255 inclusive, is a subsidiary ident\-ifi\-ca\-tion of the font within its -family. For example, bold italic condensed fonts might have the same family name -as light roman extended fonts, differing only in their face byte. (\TeX\ -ignores this information; but it is needed, for example, when converting -\.{DVI} files to \.{PRESS} files for Xerox equipment.) - -\yskip\hang\.{SEVENBITSAFEFLAG} (string value, default is `\.{FALSE}'). The -value should start with either `\.T' (true) or `\.F' (false). If true, character -codes less than 128 cannot lead to codes of 128 or more via ligatures or -charlists or extensible characters. (\TeX82 ignores this flag, but older -versions of \TeX\ would only accept \.{TFM} files that were seven-bit safe.) -\.{VPtoVF} computes the correct value of this flag and gives an error message -only if a claimed ``true'' value is incorrect. - -\yskip\hang\.{HEADER} (a one-byte value followed by a four-byte value). -The one-byte value should be between 18 and a maximum limit that can be -raised or lowered depending on the compile-time setting of |max_header_bytes|. -The four-byte value goes into the header word whose index is the one-byte -value; for example, to set |header[18]:=1|, one may write -`\.{(HEADER D 18 O 1)}'. This notation is used for header information that -is presently unnamed. (\TeX\ ignores it.) - -\yskip\hang\.{FONTDIMEN} (property list value). See below for the names -allowed in this property list. - -\yskip\hang\.{LIGTABLE} (property list value). See below for the rules -about this special kind of property list. - -\yskip\hang\.{BOUNDARYCHAR} (integer value). If this character appears in -a \.{LIGTABLE} command, it matches ``end of word'' as well as itself. -If no boundary character is given and no \.{LABEL} \.{BOUNDARYCHAR} occurs -within \.{LIGTABLE}, word boundaries will not affect ligatures or kerning. - -\yskip\hang\.{CHARACTER}. The value is an integer followed by -a property list. The integer represents the number of a character that is -present in the font; the property list of a character is defined below. -The default is an empty property list. - -@ Numeric property list values can be given in various forms identified by -a prefixed letter. - -\yskip\hang\.C denotes an ASCII character, which should be a standard visible -character that is not a parenthesis. The numeric value will therefore be -between @'41 and @'176 but not @'50 or @'51. - -\yskip\hang\.D denotes an unsigned decimal integer, which must be -less than $2^{32}$, i.e., at most `\.{D 4294967295}'. - -\yskip\hang\.F denotes a three-letter Xerox face code; the admissible codes -are \.{MRR}, \.{MIR}, \.{BRR}, \.{BIR}, \.{LRR}, \.{LIR}, \.{MRC}, \.{MIC}, -\.{BRC}, \.{BIC}, \.{LRC}, \.{LIC}, \.{MRE}, \.{MIE}, \.{BRE}, \.{BIE}, -\.{LRE}, and \.{LIE}, denoting the integers 0 to 17, respectively. - -\yskip\hang\.O denotes an unsigned octal integer, which must be less than -$2^{32}$, i.e., at most `\.{O 37777777777}'. - -\yskip\hang\.H denotes an unsigned hexadecimal integer, which must be less than -$2^{32}$, i.e., at most `\.{H FFFFFFFF}'. - -\yskip\hang\.R denotes a real number in decimal notation, optionally preceded -by a `\.+' or `\.-' sign, and optionally including a decimal point. The -absolute value must be less than 2048. - -@ The property names allowed in a \.{FONTDIMEN} property list correspond to -various \TeX\ parameters, each of which has a (real) numeric value. All -of the parameters except \.{SLANT} are in design units. The admissible -names are \.{SLANT}, \.{SPACE}, \.{STRETCH}, \.{SHRINK}, \.{XHEIGHT}, -\.{QUAD}, \.{EXTRASPACE}, \.{NUM1}, \.{NUM2}, \.{NUM3}, \.{DENOM1}, -\.{DENOM2}, \.{SUP1}, \.{SUP2}, \.{SUP3}, \.{SUB1}, \.{SUB2}, \.{SUPDROP}, -\.{SUBDROP}, \.{DELIM1}, \.{DELIM2}, and \.{AXISHEIGHT}, for parameters -1~to~22. The alternate names \.{DEFAULTRULETHICKNESS}, -\.{BIGOPSPACING1}, \.{BIGOPSPACING2}, \.{BIGOPSPACING3}, -\.{BIGOPSPACING4}, and \.{BIGOPSPACING5}, may also be used for parameters -8 to 13. - -The notation `\.{PARAMETER} $n$' provides another way to specify the -$n$th parameter; for example, `\.{(PARAMETER} \.{D 1 R -.25)}' is another way -to specify that the \.{SLANT} is $-0.25$. The value of $n$ must be positive -and less than |max_param_words|. - -@ The elements of a \.{CHARACTER} property list can be of six different types. - -\yskip\hang\.{CHARWD} (real value) denotes the character's width in -design units. - -\yskip\hang\.{CHARHT} (real value) denotes the character's height in -design units. - -\yskip\hang\.{CHARDP} (real value) denotes the character's depth in -design units. - -\yskip\hang\.{CHARIC} (real value) denotes the character's italic correction in -design units. - -\yskip\hang\.{NEXTLARGER} (integer value), specifies the character that -follows the present one in a ``charlist.'' The value must be the number of a -character in the font, and there must be no infinite cycles of supposedly -larger and larger characters. - -\yskip\hang\.{VARCHAR} (property list value), specifies an extensible character. -This option and \.{NEXTLARGER} are mutually exclusive; i.e., they cannot -both be used within the same \.{CHARACTER} list. - -\yskip\noindent -The elements of a \.{VARCHAR} property list are either \.{TOP}, \.{MID}, -\.{BOT} or \.{REP}; the values are integers, which must be zero or the number -of a character in the font. A zero value for \.{TOP}, \.{MID}, or \.{BOT} means -that the corresponding piece of the extensible character is absent. A nonzero -value, or a \.{REP} value of zero, denotes the character code used to make -up the top, middle, bottom, or replicated piece of an extensible character. - -@ A \.{LIGTABLE} property list contains elements of four kinds, specifying a -program in a simple command language that \TeX\ uses for ligatures and kerns. -If several \.{LIGTABLE} lists appear, they are effectively concatenated into -a single list. - -\yskip\hang\.{LABEL} (integer value) means that the program for the -stated character value starts here. The integer must be the number of a -character in the font; its \.{CHARACTER} property list must not have a -\.{NEXTLARGER} or \.{VARCHAR} field. At least one \.{LIG} or \.{KRN} step -must follow. - -\yskip\hang\.{LABEL} \.{BOUNDARYCHAR} means that the program for -beginning-of-word ligatures starts here. - -\yskip\hang\.{LIG} (two integer values). The instruction `\.{(LIG} $c$ $r$\.)' -means, ``If the next character is $c$, then insert character~$r$ and -possibly delete the current character and/or~$c$; -otherwise go on to the next instruction.'' -Characters $r$ and $c$ must be present in the font. \.{LIG} may be immediately -preceded or followed by a slash, and then immediately followed by \.> -characters not exceeding the number of slashes. Thus there are eight -possible forms: -$$\hbox to .8\hsize{\.{LIG}\hfil\.{/LIG}\hfil\.{/LIG>}\hfil -\.{LIG/}\hfil\.{LIG/>}\hfil\.{/LIG/}\hfil\.{/LIG/>}\hfil\.{/LIG/>>}}$$ -The slashes specify retention of the left or right original character; the -\.> signs specify passing over the result without further ligature processing. - -\yskip\hang\.{KRN} (an integer value and a real value). The instruction -`\.{(KRN} $c$ $r$\.)' means, ``If the next character is $c$, then insert -a blank space of width $r$ between the current character character and $c$; -otherwise go on to the next intruction.'' The value of $r$, which is in -units of the design size, is often negative. Character code $c$ must exist -in the font. - -\yskip\hang\.{STOP} (no value). This instruction ends a ligature/kern program. -It must follow either a \.{LIG} or \.{KRN} instruction, not a \.{LABEL} -or \.{STOP} or \.{SKIP}. - -\yskip\hang\.{SKIP} (value in the range |0..127|). This instruction specifies -continuation of a ligature/kern program after the specified number of \.{LIG} -or \.{KRN} has been skipped over. The number of subsequent \.{LIG} and \.{KRN} -instructions must therefore exceed this specified amount. - -@ In addition to all these possibilities, the property name \.{COMMENT} is -allowed in any property list. Such comments are ignored. - -@ So that is what \.{PL} files hold. In a \.{VPL} file additional -properties are recognized; two of these are valid on the outermost level: - -\yskip\hang\.{VTITLE} (string value, default is empty). The value will be -reproduced at the beginning of the \.{VF} file (and printed on the terminal -by \.{VFtoVP} when it examines that file). - -\yskip\hang\.{MAPFONT}. The value is a nonnegative integer followed by -a property list. The integer represents an identifying number for fonts -used in \.{MAP} attributes. The property list, which identifies the font and -relative size, is defined below. - -\yskip\noindent -And one additional ``virtual property'' is valid within a \.{CHARACTER}: - -\yskip\hang\.{MAP}. The value is a property list consisting of typesetting -commands. Default is the single command \.{SETCHAR}~$c$, where $c$ is -the current character number. - -@ The elements of a \.{MAPFONT} property list can be of the following types. - -\yskip\hang\.{FONTNAME} (string value, default is \.{NULL}). -This is the font's identifying name. - -\yskip\hang\.{FONTAREA} (string value, default is empty). If the font appears -in a nonstandard directory, according to local conventions, the directory -name is given here. (This is system dependent, just as in \.{DVI} files.) - -\yskip\hang\.{FONTCHECKSUM} (four-byte value, default is zero). This value, -which should be a nonnegative integer less than $2^{32}$, can be used to -check that the font being referred to matches the intended font. If nonzero, -it should equal the \.{CHECKSUM} parameter in that font. - -\yskip\hang\.{FONTAT} (numeric value, default is the \.{DESIGNUNITS} of the -present virtual font). This value is relative to the design units of -the present virtual font, hence it will be scaled when the virtual -font is magnified or reduced. It represents the value that will -effectively replace the design size of the font being referred to, -so that all characters will be scaled appropriately. - -\yskip\hang\.{FONTDSIZE} (numeric value, default is 10). This value is -absolute, in units of printer's points. It should equal the \.{DESIGNSIZE} -parameter in the font being referred to. - -\yskip\noindent -If any of the -string values contain parentheses, the parentheses must be balanced. Leading -blanks are removed from the strings, but trailing blanks are not. - -@ Finally, the elements of a \.{MAP} property list are an ordered sequence -of typesetting commands chosen from among the following: - -\yskip\hang\.{SELECTFONT} (four-byte integer value). The value must be the -number of a previously defined \.{MAPFONT}. This font (or more precisely, the -final font that is mapped to that code number, if two \.{MAPFONT} properties -happen to specify the same code) will be used in subsequent \.{SETCHAR} -instructions until overridden by another \.{SELECTFONT}. The first-specified -\.{MAPFONT} is implicitly selected before the first \.{SELECTFONT} in every -character's map. - -\yskip\hang\.{SETCHAR} (integer value). There must be a character of -this number in the currently selected font. (\.{VPtoVF} doesn't check that -the character is valid, but \.{VFtoVP} does.) That character is typeset at the -current position, and the typesetter moves right by the \.{CHARWD} in -that character's \.{TFM} file. - -\yskip\hang\.{SETRULE} (two real values). The first value specifies height, -the second specifies width, in design units. If both height and width are -positive, a rule is typeset at the current position. Then the typesetter -moves right, by the specified width. - -\yskip\hang\.{MOVERIGHT}, \.{MOVELEFT}, \.{MOVEUP}, \.{MOVEDOWN} (real -value). The typesetter moves its current position -by the number of design units specified. - -\yskip\hang\.{PUSH} The current typesetter position is remembered, to -be restored on a subsequent \.{POP}. - -\yskip\hang\.{POP} The current typesetter position is reset to where it -was on the most recent unmatched \.{PUSH}. The \.{PUSH} and \.{POP} -commands in any \.{MAP} must be properly nested like balanced parentheses. - -\yskip\hang\.{SPECIAL} (string value). The subsequent characters, starting -with the first nonblank and ending just before the first `\.)' that has no -matching `\.(', are interpreted according to local conventions with the -same system-dependent meaning as a `special' (\\{xxx}) command -in a \.{DVI} file. - -\yskip\hang\.{SPECIALHEX} (hexadecimal string value). The subsequent -nonblank characters before the next `\.)' must consist entirely of -hexadecimal digits, and they must contain an even number of such digits. -Each pair of hex digits specifies a byte, and this string of bytes is -treated just as the value of a \.{SPECIAL}. (This convention permits -arbitrary byte strings to be represented in an ordinary text file.) - -@ Virtual font mapping is a recursive process, like macro expansion. -Thus, a \.{MAPFONT} might -specify another virtual font, whose characters are themselves mapped to -other fonts. As an example of this possibility, consider the -following curious file called \.{recurse.vpl}, which defines a -virtual font that is self-contained and self-referential: -$$\vbox{\halign{\.{#}\cr -(VTITLE Example of recursion)\cr -(MAPFONT D 0 (FONTNAME recurse)(FONTAT D 2))\cr -(CHARACTER C A (CHARWD D 1)(CHARHT D 1)(MAP (SETRULE D 1 D 1)))\cr -(CHARACTER C B (CHARWD D 2)(CHARHT D 2)(MAP (SETCHAR C A)))\cr -(CHARACTER C C (CHARWD D 4)(CHARHT D 4)(MAP (SETCHAR C B)))\cr -}}$$ -The design size is 10 points (the default), hence the character \.A -in font \.{recurse} is a $10\times10$ point black square. Character \.B -is typeset as character \.A in \.{recurse} {scaled} {2000}, hence it -is a $20\times20$ point black square. And character \.C is typeset as -character \.{B} in \.{recurse} {scaled} {2000}, hence its size is -$40\times40$. - -Users are responsible for making sure that infinite recursion doesn't happen. - -@ So that is what \.{VPL} files hold. From these rules, -you can guess (correctly) that \.{VPtoVF} operates in four main stages. -First it assigns the default values to all properties; then it scans -through the \.{VPL} file, changing property values as new ones are seen; then -it checks the information and corrects any problems; and finally it outputs -the \.{VF} and \.{TFM} files. - -@ The next question is, ``What are \.{VF} and -\.{TFM} files?'' A complete answer to that question appears in the -documentation of the companion programs, \.{VFtoVP} and -\.{TFtoPL}, so the details will not -be repeated here. Suffice it to say that a \.{VF} or -\.{TFM} file stores all of the -relevant font information in a sequence of 8-bit bytes. The number of -bytes is always a multiple of 4, so we could regard the files -as sequences of 32-bit words; but \TeX\ uses the byte interpretation, -and so does \.{VPtoVF}. Note that the bytes are considered to be unsigned -numbers. - -@<Glob...@>= -@!vf_file:packed file of 0..255; -@!tfm_file:packed file of 0..255; - -@ On some systems you may have to do something special to write a -packed file of bytes. For example, the following code didn't work -when it was first tried at Stanford, because packed files have to be -opened with a special switch setting on the \PASCAL\ that was used. -@^system dependencies@> - -@<Set init...@>= -rewrite(vf_file); rewrite(tfm_file); - -@* Basic input routines. -For the purposes of this program, a |byte| is an unsigned 16-bit quantity, -and an |ASCII_code| is an integer between @'40 and @'177. Such ASCII codes -correspond to one-character constants like \.{"A"} in \.{WEB} language. - -@<Types...@>= -@!byte=0..65535; {unsigned 16-bit quantity} -@!ASCII_code=@'40..@'177; {standard ASCII code numbers} - -@ One of the things \.{VPtoVF} has to do is convert characters of strings -to ASCII form, since that is the code used for the family name and the -coding scheme in a \.{TFM} file. An array |xord| is used to do the -conversion from |char|; the method below should work with little or no change -on most \PASCAL\ systems. -@^system dependencies@> - -@d first_ord=0 {ordinal number of the smallest element of |char|} -@d last_ord=127 {ordinal number of the largest element of |char|} - -@<Global...@>= -@!xord:array[char] of ASCII_code; {conversion table} - -@ @<Local variables for init...@>= -@!k:integer; {all-purpose initialization index} - -@ Characters that should not appear in \.{VPL} files (except in comments) -are mapped into @'177. - -@d invalid_code=@'177 {code deserving an error message} - -@<Set init...@>= -for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code; -xord[' ']:=" "; xord['!']:="!"; xord['"']:=""""; xord['#']:="#"; -xord['$']:="$"; xord['%']:="%"; xord['&']:="&"; xord['''']:="'"; -xord['(']:="("; xord[')']:=")"; xord['*']:="*"; xord['+']:="+"; xord[',']:=","; -xord['-']:="-"; xord['.']:="."; xord['/']:="/"; xord['0']:="0"; xord['1']:="1"; -xord['2']:="2"; xord['3']:="3"; xord['4']:="4"; xord['5']:="5"; xord['6']:="6"; -xord['7']:="7"; xord['8']:="8"; xord['9']:="9"; xord[':']:=":"; xord[';']:=";"; -xord['<']:="<"; xord['=']:="="; xord['>']:=">"; xord['?']:="?"; -xord['@@']:="@@"; xord['A']:="A"; xord['B']:="B"; xord['C']:="C"; -xord['D']:="D"; xord['E']:="E"; xord['F']:="F"; xord['G']:="G"; xord['H']:="H"; -xord['I']:="I"; xord['J']:="J"; xord['K']:="K"; xord['L']:="L"; xord['M']:="M"; -xord['N']:="N"; xord['O']:="O"; xord['P']:="P"; xord['Q']:="Q"; xord['R']:="R"; -xord['S']:="S"; xord['T']:="T"; xord['U']:="U"; xord['V']:="V"; xord['W']:="W"; -xord['X']:="X"; xord['Y']:="Y"; xord['Z']:="Z"; xord['[']:="["; xord['\']:="\"; -xord[']']:="]"; xord['^']:="^"; xord['_']:="_"; xord['`']:="`"; xord['a']:="a"; -xord['b']:="b"; xord['c']:="c"; xord['d']:="d"; xord['e']:="e"; xord['f']:="f"; -xord['g']:="g"; xord['h']:="h"; xord['i']:="i"; xord['j']:="j"; xord['k']:="k"; -xord['l']:="l"; xord['m']:="m"; xord['n']:="n"; xord['o']:="o"; xord['p']:="p"; -xord['q']:="q"; xord['r']:="r"; xord['s']:="s"; xord['t']:="t"; xord['u']:="u"; -xord['v']:="v"; xord['w']:="w"; xord['x']:="x"; xord['y']:="y"; xord['z']:="z"; -xord['{']:="{"; xord['|']:="|"; xord['}']:="}"; xord['~']:="~"; - -@ In order to help catch errors of badly nested parentheses, \.{VPtoVF} -assumes that the user will begin each line with a number of blank spaces equal -to some constant times the number of open parentheses at the beginning of -that line. However, the program doesn't know in advance what the constant -is, nor does it want to print an error message on every line for a user -who has followed no consistent pattern of indentation. - -Therefore the following strategy is adopted: If the user has been consistent -with indentation for ten or more lines, an indentation error will be -reported. The constant of indentation is reset on every line that should -have nonzero indentation. - -@<Glob...@>= -@!line:integer; {the number of the current line} -@!good_indent:integer; {the number of lines since the last bad indentation} -@!indent: integer; {the number of spaces per open parenthesis, zero if unknown} -@!level: integer; {the current number of open parentheses} - -@ @<Set init...@>= -line:=0; good_indent:=0; indent:=0; level:=0; - -@ The input need not really be broken into lines of any maximum length, and -we could read it character by character without any buffering. But we shall -place it into a small buffer so that offending lines can be displayed in error -messages. - -@<Glob...@>= -@!left_ln,@!right_ln:boolean; {are the left and right ends of the buffer - at end-of-line marks?} -@!limit:0..buf_size; {position of the last character present in the buffer} -@!loc:0..buf_size; {position of the last character read in the buffer} -@!buffer:array[1..buf_size] of char; -@!input_has_ended:boolean; {there is no more input to read} - -@ @<Set init...@>= -limit:=0; loc:=0; left_ln:=true; right_ln:=true; input_has_ended:=false; - -@ Just before each \.{CHARACTER} property list is evaluated, the character -code is printed in octal notation. Up to eight such codes appear on a line; -so we have a variable to keep track of how many are currently there. - -@<Glob...@>= -@!chars_on_line:0..8; {the number of characters printed on the current line} - -@ @<Set init...@>= -chars_on_line:=0; - -@ The following routine prints an error message and an indication of -where the error was detected. The error message should not include any -final punctuation, since this procedure supplies its own. - -@d err_print(#)==begin if chars_on_line>0 then print_ln(' '); - print(#); show_error_context; - end - -@p procedure show_error_context; {prints the current scanner location} -var k:0..buf_size; {an index into |buffer|} -begin print_ln(' (line ',line:1,').'); -if not left_ln then print('...'); -for k:=1 to loc do print(buffer[k]); {print the characters already scanned} -print_ln(' '); -if not left_ln then print(' '); -for k:=1 to loc do print(' '); {space out the second line} -for k:=loc+1 to limit do print(buffer[k]); {print the characters yet unseen} -if right_ln then print_ln(' ')@+else print_ln('...'); -chars_on_line:=0; -end; - -@ Here is a procedure that does the right thing when we are done -reading the present contents of the buffer. It keeps |buffer[buf_size]| -empty, in order to avoid range errors on certain \PASCAL\ compilers. - -An infinite sequence of right parentheses is placed at the end of the -file, so that the program is sure to get out of whatever level of nesting -it is in. - -On some systems it is desirable to modify this code so that tab marks -in the buffer are replaced by blank spaces. (Simply setting -|xord[chr(@'11)]:=" "| would not work; for example, two-line -error messages would not come out properly aligned.) -@^system dependencies@> - -@p procedure fill_buffer; -begin left_ln:=right_ln; limit:=0; loc:=0; -if left_ln then begin - if line>0 then read_ln(vpl_file); - incr(line); - end; -if eof(vpl_file) then begin - limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true; - end -else begin - while (limit<buf_size-1)and(not eoln(vpl_file)) do begin - incr(limit); read(vpl_file,buffer[limit]); - end; - buffer[limit+1]:=' '; right_ln:=eoln(vpl_file); - if left_ln then @<Set |loc| to the number of leading blanks in - the buffer, and check the indentation@>; - end; -end; - -@ The interesting part about |fill_buffer| is the part that learns what -indentation conventions the user is following, if any. - -@d bad_indent(#)==begin if good_indent>=10 then err_print(#); - good_indent:=0; indent:=0; - end - -@<Set |loc|...@>= -begin while (loc<limit)and(buffer[loc+1]=' ') do incr(loc); -if loc<limit then begin - if level=0 then - if loc=0 then incr(good_indent) - else bad_indent('Warning: Indented line occurred at level zero') -@.Warning: Indented line...@> - else if indent=0 then - if loc mod level=0 then begin - indent:=loc div level; good_indent:=1; - end - else good_indent:=0 - else if indent*level=loc then incr(good_indent) - else bad_indent('Warning: Inconsistent indentation; ', -@.Warning: Inconsistent indentation...@> - 'you are at parenthesis level ',level:1); - end; -end - -@* Basic scanning routines. -The global variable |cur_char| holds the ASCII code corresponding to the -character most recently read from the input buffer, or to a character that -has been substituted for the real one. - -@<Global...@>= -@!cur_char:ASCII_code; {we have just read this} - -@ Here is a procedure that sets |cur_char| to an ASCII code for the -next character of input, if that character is a letter or digit or slash -or \.>. Otherwise -it sets |cur_char:=" "|, and the input system will be poised to reread the -character that was rejected, whether or not it was a space. -Lower case letters are converted to upper case. - -@p procedure get_keyword_char; -begin while (loc=limit)and(not right_ln) do fill_buffer; -if loc=limit then cur_char:=" " {end-of-line counts as a delimiter} -else begin - cur_char:=xord[buffer[loc+1]]; - if cur_char>="a" then cur_char:=cur_char-@'40; - if ((cur_char>="0")and(cur_char<="9")) then incr(loc) - else if ((cur_char>="A")and(cur_char<="Z")) then incr(loc) - else if cur_char="/" then incr(loc) - else if cur_char=">" then incr(loc) - else cur_char:=" "; - end; -end; - -@ The following procedure sets |cur_char| to the next character code, -and converts lower case to upper case. If the character is a left or -right parenthesis, it will not be ``digested''; the character will -be read again and again, until the calling routine does something -like `|incr(loc)|' to get past it. Such special treatment of parentheses -insures that the structural information they contain won't be lost in -the midst of other error recovery operations. - -@d backup==begin if (cur_char>")")or(cur_char<"(") then decr(loc); - end {undoes the effect of |get_next|} - -@p procedure get_next; {sets |cur_char| to next, balks at parentheses} -begin while loc=limit do fill_buffer; -incr(loc); cur_char:=xord[buffer[loc]]; -if cur_char>="a" then - if cur_char<="z" then cur_char:=cur_char-@'40 {uppercasify} - else begin - if cur_char=invalid_code then begin - err_print('Illegal character in the file'); -@.Illegal character...@> - cur_char:="?"; - end; - end -else if (cur_char<=")")and(cur_char>="(") then decr(loc); -end; - -@ Here's a procedure that scans a hexadecimal digit or a right parenthesis. - -@p function get_hex:byte; -var @!a:integer; {partial result} -begin repeat get_next; -until cur_char<>" "; -a:=cur_char-")"; -if a>0 then begin - a:=cur_char-"0"; - if cur_char>"9" then - if cur_char<"A" then a:=-1 else a:=cur_char-"A"+10; - end; -if (a<0)or(a>15) then begin - err_print('Illegal hexadecimal digit'); get_hex:=0; -@.Illegal hexadecimal digit@> - end -else get_hex:=a; -end; - -@ The next procedure is used to ignore the text of a comment, or to pass over -erroneous material. As such, it has the privilege of passing parentheses. -It stops after the first right parenthesis that drops the level below -the level in force when the procedure was called. - -@p procedure skip_to_end_of_item; -var l:integer; {initial value of |level|} -begin l:=level; -while level>=l do begin - while loc=limit do fill_buffer; - incr(loc); - if buffer[loc]=')' then decr(level) - else if buffer[loc]='(' then incr(level); - end; -if input_has_ended then err_print('File ended unexpectedly: No closing ")"'); -@.File ended unexpectedly...@> -cur_char:=" "; {now the right parenthesis has been read and digested} -end; - -@ A similar procedure copies the bytes remaining in an item. The copied bytes -go into an array |vf| that we'll declare later. Leading blanks are ignored. - -@d vf_store(#)== - begin vf[vf_ptr]:=#; - if vf_ptr=vf_size then err_print('I''m out of memory---increase my vfsize!') -@.I'm out of memory...@> - else incr(vf_ptr); - end - -@p procedure copy_to_end_of_item; -label 30; -var l:integer; {initial value of |level|} -@!nonblank_found:boolean; {have we seen a nonblank character yet?} -begin l:=level; nonblank_found:=false; -while true do begin - while loc=limit do fill_buffer; - if buffer[loc+1]=')' then - if level=l then goto 30@+else decr(level); - incr(loc); - if buffer[loc]='(' then incr(level); - if buffer[loc]<>' ' then nonblank_found:=true; - if nonblank_found then - if xord[buffer[loc]]=invalid_code then begin - err_print('Illegal character in the file'); -@.Illegal character...@> - vf_store("?"); - end - else vf_store(xord[buffer[loc]]); - end; -30:end; - -@ Sometimes we merely want to skip past characters in the input until we -reach a left or a right parenthesis. For example, we do this whenever we -have finished scanning a property value and we hope that a right parenthesis -is next (except for possible blank spaces). - -@d skip_to_paren==repeat get_next@;@+ until (cur_char="(")or(cur_char=")") -@d skip_error(#)==begin err_print(#); skip_to_paren; - end {this gets to the right parenthesis if something goes wrong} -@d flush_error(#)==begin err_print(#); skip_to_end_of_item; - end {this gets past the right parenthesis if something goes wrong} - -@ After a property value has been scanned, we want to move just past the -right parenthesis that should come next in the input (except for possible -blank spaces). - -@p procedure finish_the_property; {do this when the value has been scanned} -begin while cur_char=" " do get_next; -if cur_char<>")" then err_print('Junk after property value will be ignored'); -@.Junk after property value...@> -skip_to_end_of_item; -end; - -@* Scanning property names. -We have to figure out the meaning of names that appear in the \.{VPL} file, -by looking them up in a dictionary of known keywords. Keyword number $n$ -appears in locations |start[n]| through |start[n+1]-1| of an array called -|dictionary|. - -@d max_name_index=300 {upper bound on the number of keywords} -@d max_letters=3000 {upper bound on the total length of all keywords} - -@<Global...@>= -@!start:array[1..max_name_index] of 0..max_letters; -@!dictionary:array[0..max_letters] of ASCII_code; -@!start_ptr:0..max_name_index; {the first available place in |start|} -@!dict_ptr:0..max_letters; {the first available place in |dictionary|} - -@ @<Set init...@>= -start_ptr:=1; start[1]:=0; dict_ptr:=0; - -@ When we are looking for a name, we put it into the |cur_name| array. -When we have found it, the corresponding |start| index will go into -the global variable |name_ptr|. - -@d longest_name=20 {length of \.{DEFAULTRULETHICKNESS}} - -@<Glob...@>= -@!cur_name:array[1..longest_name] of ASCII_code; {a name to look up} -@!name_length:0..longest_name; {its length} -@!name_ptr:0..max_name_index; {its ordinal number in the dictionary} - -@ A conventional hash table with linear probing (cf.\ Algorithm 6.4L -in {\sl The Art of Computer Pro\-gram\-ming\/}) is used for the dictionary -operations. If |nhash[h]=0|, the table position is empty, otherwise |nhash[h]| -points into the |start| array. - -@d hash_prime=307 {size of the hash table} - -@<Glob...@>= -@!nhash:array[0..hash_prime-1] of 0..max_name_index; -@!cur_hash:0..hash_prime-1; {current position in the hash table} - -@ @<Local...@>= -@!h:0..hash_prime-1; {runs through the hash table} - -@ @<Set init...@>= -for h:=0 to hash_prime-1 do nhash[h]:=0; - -@ Since there is no chance of the hash table overflowing, the procedure -is very simple. After |lookup| has done its work, |cur_hash| will point -to the place where the given name was found, or where it should be inserted. - -@p procedure lookup; {finds |cur_name| in the dictionary} -var k:0..longest_name; {index into |cur_name|} -@!j:0..max_letters; {index into |dictionary|} -@!not_found:boolean; {clumsy thing necessary to avoid |goto| statement} -@!cur_hash_reset:boolean; -begin @<Compute the hash code, |cur_hash|, for |cur_name|@>; -not_found:=true; -cur_hash_reset:=false; -while not_found do begin - if (cur_hash=0) and (cur_hash_reset) then - not_found:=false - else begin - if cur_hash=0 then begin - cur_hash:=hash_prime-1; - cur_hash_reset:=true - end - else decr(cur_hash); - if nhash[cur_hash]=0 then not_found:=false - else begin - j:=start[nhash[cur_hash]]; - if start[nhash[cur_hash]+1]=j+name_length then begin - not_found:=false; - for k:=1 to name_length do - if dictionary[j+k-1]<>cur_name[k] then not_found:=true; - end - end - end - end; -name_ptr:=nhash[cur_hash]; -end; - -@ @<Compute the hash...@>= -cur_hash:=cur_name[1]; -for k:=2 to name_length do - cur_hash:=(cur_hash+cur_hash+cur_name[k]) mod hash_prime - -@ The ``meaning'' of the keyword that begins at |start[k]| in the -dictionary is kept in |equiv[k]|. The numeric |equiv| codes are given -symbolic meanings by the following definitions. - -@d comment_code=0 -@d check_sum_code=1 -@d design_size_code=2 -@d design_units_code=3 -@d coding_scheme_code=4 -@d family_code=5 -@d face_code=6 -@d seven_bit_safe_flag_code=7 -@d header_code= 8 -@d font_dimen_code=9 -@d lig_table_code=10 -@d boundary_char_code=11 -@d virtual_title_code=12 -@d map_font_code=13 -@d font_dir_code=14 -@d n_font_dir_code=15 -@d character_code=16 -@d font_name_code=21 -@d font_area_code=22 -@d font_checksum_code=23 -@d font_at_code=24 -@d font_dsize_code=25 -@d parameter_code=30 -@d char_info_code=70 -@d width=1 -@d height=2 -@d depth=3 -@d italic=4 -@d sec_width=5 -@d sec_height=6 -@d sec_depth=7 -@d sec_italic=8 -@d accent=9 -@d prim_top_axis=10 -@d prim_top_axis_bis=11 -@d prim_bot_axis=12 -@d prim_bot_axis_bis=13 -@d prim_mid_hor=14 -@d prim_mid_vert=15 -@d prim_base_slant=16 -@d sec_top_axis=17 -@d sec_top_axis_bis=18 -@d sec_bot_axis=19 -@d sec_bot_axis_bis=20 -@d sec_mid_hor=21 -@d sec_mid_vert=22 -@d sec_base_slant=23 -@d char_wd_code=char_info_code+width -@d char_ht_code=char_info_code+height -@d char_dp_code=char_info_code+depth -@d char_ic_code=char_info_code+italic -@d sec_width_code=char_info_code+sec_width -@d sec_height_code=char_info_code+sec_height -@d sec_depth_code=char_info_code+sec_depth -@d sec_italic_code=char_info_code+sec_italic -@d accent_code=char_info_code+accent -@d prim_top_axis_code=char_info_code+prim_top_axis -@d prim_top_axis_bis_code=char_info_code+prim_top_axis_bis -@d prim_bot_axis_code=char_info_code+prim_bot_axis -@d prim_bot_axis_bis_code=char_info_code+prim_bot_axis_bis -@d prim_mid_hor_code=char_info_code+prim_mid_hor -@d prim_mid_vert_code=char_info_code+prim_mid_vert -@d prim_base_slant_code=char_info_code+prim_base_slant -@d sec_top_axis_code=char_info_code+sec_top_axis -@d sec_top_axis_bis_code=char_info_code+sec_top_axis_bis -@d sec_bot_axis_code=char_info_code+sec_bot_axis -@d sec_bot_axis_bis_code=char_info_code+sec_bot_axis_bis -@d sec_mid_hor_code=char_info_code+sec_mid_hor -@d sec_mid_vert_code=char_info_code+sec_mid_vert -@d sec_base_slant_code=char_info_code+sec_base_slant -@d next_larger_code=100 -@d map_code=101 -@d var_char_code=102 -@d select_font_code=110 -@d set_char_code=111 -@d set_rule_code=112 -@d move_right_code=113 -@d move_down_code=115 -@d push_code=117 -@d pop_code=118 -@d special_code=119 -@d special_hex_code=120 -@d label_code=130 -@d stop_code=131 -@d skip_code=132 -@d krn_code=133 -@d lig_code=134 -@d ofm_level_code=140 -@d char_repeat_code=150 -@d char_ivalue_code=151 -@d char_fvalue_code=152 -@d char_mvalue_code=153 -@d char_rule_code=154 -@d char_glue_code=155 -@d char_penalty_code=156 -@d font_rule_code=160 -@d rule_code=161 -@d rule_width_code=162 -@d rule_height_code=163 -@d rule_depth_code=164 -@d font_glue_code=170 -@d glue_code=171 -@d glue_type_code=172 -@d glue_stretch_order_code=173 -@d glue_shrink_order_code=174 -@d glue_width_code=175 -@d glue_stretch_code=176 -@d glue_shrink_code=177 -@d glue_char_code=178 -@d glue_rule_code=179 -@d order_unit_code=181 -@d order_fi_code=182 -@d order_fil_code=183 -@d order_fill_code=184 -@d order_filll_code=185 -@d type_normal_code=186 -@d type_aleaders_code=187 -@d type_cleaders_code=188 -@d type_xleaders_code=189 -@d font_penalty_code=190 -@d penalty_code=191 -@d penalty_val_code=192 -@d font_mvalue_code=200 -@d mvalue_code=201 -@d mvalue_val_code=202 -@d font_fvalue_code=210 -@d fvalue_code=211 -@d fvalue_val_code=212 -@d font_ivalue_code=220 -@d ivalue_code=221 -@d ivalue_val_code=222 -@d clabel_code=231 -@d cpen_code=232 -@d cglue_code=233 -@d cpenglue_code=234 -@d ckrn_code=235 -@d TL_dir_code=240 -@d LT_dir_code=241 -@d TR_dir_code=242 -@d LB_dir_code=243 -@d BL_dir_code=244 -@d RT_dir_code=245 -@d BR_dir_code=246 -@d RB_dir_code=247 - -@<Glo...@>= -@!equiv:array[0..max_name_index] of byte; -@!cur_code:byte; {equivalent most recently found in |equiv|} - -@ We have to get the keywords into the hash table and into the dictionary in -the first place (sigh). The procedure that does this has the desired -|equiv| code as a parameter. In order to facilitate \.{WEB} macro writing -for the initialization, the keyword being initialized is placed into the -last positions of |cur_name|, instead of the first positions. - -@p procedure enter_name(v:byte); {|cur_name| goes into the dictionary} -var k:0..longest_name; -begin for k:=1 to name_length do - cur_name[k]:=cur_name[k+longest_name-name_length]; -{now the name has been shifted into the correct position} -lookup; {this sets |cur_hash| to the proper insertion place} -nhash[cur_hash]:=start_ptr; equiv[start_ptr]:=v; -for k:=1 to name_length do begin - dictionary[dict_ptr]:=cur_name[k]; incr(dict_ptr); - end; -incr(start_ptr); start[start_ptr]:=dict_ptr; -end; - -@ Here are the macros to load a name of up to 20 letters into the -dictionary. For example, the macro |load5| is used for five-letter keywords. - -@d tail(#)==enter_name(#) -@d t20(#)==cur_name[20]:=#;tail -@d t19(#)==cur_name[19]:=#;t20 -@d t18(#)==cur_name[18]:=#;t19 -@d t17(#)==cur_name[17]:=#;t18 -@d t16(#)==cur_name[16]:=#;t17 -@d t15(#)==cur_name[15]:=#;t16 -@d t14(#)==cur_name[14]:=#;t15 -@d t13(#)==cur_name[13]:=#;t14 -@d t12(#)==cur_name[12]:=#;t13 -@d t11(#)==cur_name[11]:=#;t12 -@d t10(#)==cur_name[10]:=#;t11 -@d t9(#)==cur_name[9]:=#;t10 -@d t8(#)==cur_name[8]:=#;t9 -@d t7(#)==cur_name[7]:=#;t8 -@d t6(#)==cur_name[6]:=#;t7 -@d t5(#)==cur_name[5]:=#;t6 -@d t4(#)==cur_name[4]:=#;t5 -@d t3(#)==cur_name[3]:=#;t4 -@d t2(#)==cur_name[2]:=#;t3 -@d t1(#)==cur_name[1]:=#;t2 -@d load2==name_length:=2;t19 -@d load3==name_length:=3;t18 -@d load4==name_length:=4;t17 -@d load5==name_length:=5;t16 -@d load6==name_length:=6;t15 -@d load7==name_length:=7;t14 -@d load8==name_length:=8;t13 -@d load9==name_length:=9;t12 -@d load10==name_length:=10;t11 -@d load11==name_length:=11;t10 -@d load12==name_length:=12;t9 -@d load13==name_length:=13;t8 -@d load14==name_length:=14;t7 -@d load15==name_length:=15;t6 -@d load16==name_length:=16;t5 -@d load17==name_length:=17;t4 -@d load18==name_length:=18;t3 -@d load19==name_length:=19;t2 -@d load20==name_length:=20;t1 - -@ (Thank goodness for keyboard macros in the text editor used to create this -\.{WEB} file.) - -@<Enter all the \.{PL} names and their equivalents, - except the parameter names@>= -equiv[0]:=comment_code; {this is used after unknown keywords} -load8("C")("H")("E")("C")("K")("S")("U")("M")(check_sum_code);@/ -load10("D")("E")("S")("I")("G")("N")("S")("I")("Z")("E")(design_size_code);@/ -load11("D")("E")("S")("I")("G")("N") - ("U")("N")("I")("T")("S")(design_units_code);@/ -load12("C")("O")("D")("I")("N")("G") - ("S")("C")("H")("E")("M")("E")(coding_scheme_code);@/ -load6("F")("A")("M")("I")("L")("Y")(family_code);@/ -load4("F")("A")("C")("E")(face_code);@/ -load16("S")("E")("V")("E")("N")("B")("I")("T")@/@t\hskip2em@> - ("S")("A")("F")("E")("F")("L")("A")("G")(seven_bit_safe_flag_code);@/ -load6("H")("E")("A")("D")("E")("R")(header_code);@/ -load9("F")("O")("N")("T")("D")("I")("M")("E")("N")(font_dimen_code);@/ -load8("L")("I")("G")("T")("A")("B")("L")("E")(lig_table_code);@/ -load12("B")("O")("U")("N")("D")("A")("R")("Y")("C")("H")("A")("R") - (boundary_char_code);@/ -load9("C")("H")("A")("R")("A")("C")("T")("E")("R")(character_code);@/ -load9("P")("A")("R")("A")("M")("E")("T")("E")("R")(parameter_code);@/ -load6("C")("H")("A")("R")("W")("D")(char_wd_code);@/ -load6("C")("H")("A")("R")("H")("T")(char_ht_code);@/ -load6("C")("H")("A")("R")("D")("P")(char_dp_code);@/ -load6("C")("H")("A")("R")("I")("C")(char_ic_code);@/ -load5("S")("E")("C")("W")("D")(sec_width_code);@/ -load5("S")("E")("C")("H")("T")(sec_height_code);@/ -load5("S")("E")("C")("D")("P")(sec_depth_code);@/ -load5("S")("E")("C")("I")("C")(sec_italic_code);@/ -load6("A")("C")("C")("E")("N")("T")(accent_code);@/ -load11("P")("R")("I")("M")("T")("O")("P")("A")("X")("I")("S")(prim_top_axis_code);@/ -load14("P")("R")("I")("M")("T")("O")("P")("A")("X")("I")("S")("B")("I")("S")(prim_top_axis_bis_code);@/ -load11("P")("R")("I")("M")("B")("O")("T")("A")("X")("I")("S")(prim_bot_axis_code);@/ -load14("P")("R")("I")("M")("B")("O")("T")("A")("X")("I")("S")("B")("I")("S")(prim_bot_axis_bis_code);@/ -load10("P")("R")("I")("M")("M")("I")("D")("H")("O")("R")(prim_mid_hor_code);@/ -load10("P")("R")("I")("M")("M")("I")("D")("V")("E")("R")(prim_mid_vert_code);@/ -load13("P")("R")("I")("M")("B")("A")("S")("E")("S")("L")("A")("N")("T")(prim_base_slant_code);@/ -load10("S")("E")("C")("T")("O")("P")("A")("X")("I")("S")(sec_top_axis_code);@/ -load13("S")("E")("C")("T")("O")("P")("A")("X")("I")("S")("B")("I")("S")(sec_top_axis_bis_code);@/ -load10("S")("E")("C")("B")("O")("T")("A")("X")("I")("S")(sec_bot_axis_code);@/ -load13("S")("E")("C")("B")("O")("T")("A")("X")("I")("S")("B")("I")("S")(sec_bot_axis_bis_code);@/ -load9("S")("E")("C")("M")("I")("D")("H")("O")("R")(sec_mid_hor_code);@/ -load9("S")("E")("C")("M")("I")("D")("V")("E")("R")(sec_mid_vert_code);@/ -load12("S")("E")("C")("B")("A")("S")("E")("S")("L")("A")("N")("T")(sec_base_slant_code);@/ -load10("N")("E")("X")("T")("L")("A")("R")("G")("E")("R")(next_larger_code);@/ -load7("V")("A")("R")("C")("H")("A")("R")(var_char_code);@/ -load3("T")("O")("P")(var_char_code+1);@/ -load3("M")("I")("D")(var_char_code+2);@/ -load3("B")("O")("T")(var_char_code+3);@/ -load3("R")("E")("P")(var_char_code+4);@/ -load3("E")("X")("T")(var_char_code+4); {compatibility with older \.{PL} format} -load7("C")("O")("M")("M")("E")("N")("T")(comment_code);@/ -load5("L")("A")("B")("E")("L")(label_code);@/ -load4("S")("T")("O")("P")(stop_code);@/ -load4("S")("K")("I")("P")(skip_code);@/ -load3("K")("R")("N")(krn_code);@/ -load3("L")("I")("G")(lig_code);@/ -load4("/")("L")("I")("G")(lig_code+2);@/ -load5("/")("L")("I")("G")(">")(lig_code+6);@/ -load4("L")("I")("G")("/")(lig_code+1);@/ -load5("L")("I")("G")("/")(">")(lig_code+5);@/ -load5("/")("L")("I")("G")("/")(lig_code+3);@/ -load6("/")("L")("I")("G")("/")(">")(lig_code+7);@/ -load7("/")("L")("I")("G")("/")(">")(">")(lig_code+11);@/ -load6("C")("L")("A")("B")("E")("L")(clabel_code);@/ -load4("C")("P")("E")("N")(cpen_code);@/ -load5("C")("G")("L")("U")("E")(cglue_code);@/ -load8("C")("P")("E")("N")("G")("L")("U")("E")(cpenglue_code);@/ -load4("C")("K")("R")("N")(ckrn_code);@/ -load8("O")("F")("M")("L")("E")("V")("E")("L")(ofm_level_code);@/ -load7("F")("O")("N")("T")("D")("I")("R")(font_dir_code);@/ -load8("N")("F")("O")("N")("T")("D")("I")("R")(n_font_dir_code);@/ -load10("C")("H")("A")("R")("R")("E")("P")("E")("A")("T")(char_repeat_code);@/ -load10("C")("H")("A")("R")("I")("V")("A")("L")("U")("E")(char_ivalue_code);@/ -load10("C")("H")("A")("R")("F")("V")("A")("L")("U")("E")(char_fvalue_code);@/ -load10("C")("H")("A")("R")("M")("V")("A")("L")("U")("E")(char_mvalue_code);@/ -load8("C")("H")("A")("R")("R")("U")("L")("E")(char_rule_code);@/ -load8("C")("H")("A")("R")("G")("L")("U")("E")(char_glue_code);@/ -load11("C")("H")("A")("R")("P")("E")("N")("A")("L")("T")("Y")(char_penalty_code);@/ -load8("F")("O")("N")("T")("R")("U")("L")("E")(font_rule_code);@/ -load4("R")("U")("L")("E")(rule_code);@/ -load6("R")("U")("L")("E")("W")("D")(rule_width_code);@/ -load6("R")("U")("L")("E")("H")("T")(rule_height_code);@/ -load6("R")("U")("L")("E")("D")("P")(rule_depth_code);@/ -load8("F")("O")("N")("T")("G")("L")("U")("E")(font_glue_code);@/ -load4("G")("L")("U")("E")(glue_code);@/ -load8("G")("L")("U")("E")("T")("Y")("P")("E")(glue_type_code);@/ -load16("G")("L")("U")("E")("S")("T")("R")("E")("T")("C")("H")("O")("R")("D")("E")("R")(glue_stretch_order_code);@/ -load15("G")("L")("U")("E")("S")("H")("R")("I")("N")("K")("O")("R")("D")("E")("R")(glue_shrink_order_code);@/ -load8("G")("L")("U")("E")("R")("U")("L")("E")(glue_rule_code);@/ -load8("G")("L")("U")("E")("C")("H")("A")("R")(glue_char_code);@/ -load6("G")("L")("U")("E")("W")("D")(glue_width_code);@/ -load11("G")("L")("U")("E")("S")("T")("R")("E")("T")("C")("H")(glue_stretch_code);@/ -load10("G")("L")("U")("E")("S")("H")("R")("I")("N")("K")(glue_shrink_code);@/ -load4("U")("N")("I")("T")(order_unit_code);@/ -load2("F")("I")(order_fi_code);@/ -load3("F")("I")("L")(order_fil_code);@/ -load4("F")("I")("L")("L")(order_fill_code);@/ -load5("F")("I")("L")("L")("L")(order_filll_code);@/ -load6("N")("O")("R")("M")("A")("L")(type_normal_code);@/ -load8("A")("L")("E")("A")("D")("E")("R")("S")(type_aleaders_code);@/ -load8("C")("L")("E")("A")("D")("E")("R")("S")(type_cleaders_code);@/ -load8("X")("L")("E")("A")("D")("E")("R")("S")(type_xleaders_code);@/ -load11("F")("O")("N")("T")("P")("E")("N")("A")("L")("T")("Y")(font_penalty_code);@/ -load7("P")("E")("N")("A")("L")("T")("Y")(penalty_code);@/ -load10("P")("E")("N")("A")("L")("T")("Y")("V")("A")("L")(penalty_val_code);@/ -load10("F")("O")("N")("T")("M")("V")("A")("L")("U")("E")(font_mvalue_code);@/ -load6("M")("V")("A")("L")("U")("E")(mvalue_code);@/ -load9("M")("V")("A")("L")("U")("E")("V")("A")("L")(mvalue_val_code);@/ -load10("F")("O")("N")("T")("F")("V")("A")("L")("U")("E")(font_fvalue_code);@/ -load6("F")("V")("A")("L")("U")("E")(fvalue_code);@/ -load9("F")("V")("A")("L")("U")("E")("V")("A")("L")(fvalue_val_code);@/ -load10("F")("O")("N")("T")("I")("V")("A")("L")("U")("E")(font_ivalue_code);@/ -load6("I")("V")("A")("L")("U")("E")(ivalue_code);@/ -load9("I")("V")("A")("L")("U")("E")("V")("A")("L")(ivalue_val_code);@/ -load2("T")("L")(TL_dir_code); -load2("L")("T")(LT_dir_code); -load2("T")("R")(TR_dir_code); -load2("L")("B")(LB_dir_code); -load2("B")("L")(BL_dir_code); -load2("R")("T")(RT_dir_code); -load2("B")("R")(BR_dir_code); -load2("R")("B")(RB_dir_code); - -@ \.{VPL} files may contain the following in addition to the \.{PL} names. - -@<Enter all the \.{VPL} names@>= -load6("V")("T")("I")("T")("L")("E")(virtual_title_code);@/ -load7("M")("A")("P")("F")("O")("N")("T")(map_font_code);@/ -load3("M")("A")("P")(map_code);@/ -load8("F")("O")("N")("T")("N")("A")("M")("E")(font_name_code);@/ -load8("F")("O")("N")("T")("A")("R")("E")("A")(font_area_code);@/ -load12("F")("O")("N")("T") - ("C")("H")("E")("C")("K")("S")("U")("M")(font_checksum_code);@/ -load6("F")("O")("N")("T")("A")("T")(font_at_code);@/ -load9("F")("O")("N")("T")("D")("S")("I")("Z")("E")(font_dsize_code);@/ -load10("S")("E")("L")("E")("C")("T")("F")("O")("N")("T")(select_font_code);@/ -load7("S")("E")("T")("C")("H")("A")("R")(set_char_code);@/ -load7("S")("E")("T")("R")("U")("L")("E")(set_rule_code);@/ -load9("M")("O")("V")("E")("R")("I")("G")("H")("T")(move_right_code);@/ -load8("M")("O")("V")("E")("L")("E")("F")("T")(move_right_code+1);@/ -load8("M")("O")("V")("E")("D")("O")("W")("N")(move_down_code);@/ -load6("M")("O")("V")("E")("U")("P")(move_down_code+1);@/ -load4("P")("U")("S")("H")(push_code);@/ -load3("P")("O")("P")(pop_code);@/ -load7("S")("P")("E")("C")("I")("A")("L")(special_code);@/ -load10("S")("P")("E")("C")("I")("A")("L")("H")("E")("X")(special_hex_code);@/ - -@ @<Enter the parameter names@>= -load5("S")("L")("A")("N")("T")(parameter_code+1);@/ -load5("S")("P")("A")("C")("E")(parameter_code+2);@/ -load7("S")("T")("R")("E")("T")("C")("H")(parameter_code+3);@/ -load6("S")("H")("R")("I")("N")("K")(parameter_code+4);@/ -load7("X")("H")("E")("I")("G")("H")("T")(parameter_code+5);@/ -load4("Q")("U")("A")("D")(parameter_code+6);@/ -load10("E")("X")("T")("R")("A")("S")("P")("A")("C")("E")(parameter_code+7);@/ -load4("N")("U")("M")("1")(parameter_code+8);@/ -load4("N")("U")("M")("2")(parameter_code+9);@/ -load4("N")("U")("M")("3")(parameter_code+10);@/ -load6("D")("E")("N")("O")("M")("1")(parameter_code+11);@/ -load6("D")("E")("N")("O")("M")("2")(parameter_code+12);@/ -load4("S")("U")("P")("1")(parameter_code+13);@/ -load4("S")("U")("P")("2")(parameter_code+14);@/ -load4("S")("U")("P")("3")(parameter_code+15);@/ -load4("S")("U")("B")("1")(parameter_code+16);@/ -load4("S")("U")("B")("2")(parameter_code+17);@/ -load7("S")("U")("P")("D")("R")("O")("P")(parameter_code+18);@/ -load7("S")("U")("B")("D")("R")("O")("P")(parameter_code+19);@/ -load6("D")("E")("L")("I")("M")("1")(parameter_code+20);@/ -load6("D")("E")("L")("I")("M")("2")(parameter_code+21);@/ -load10("A")("X")("I")("S")("H")("E")("I")("G")("H")("T")(parameter_code+22);@/ -load20("D")("E")("F")("A")("U")("L")("T")("R")("U")("L")("E")@/@t\hskip2em@> - ("T")("H")("I")("C")("K")("N")("E")("S")("S")(parameter_code+8);@/ -load13("B")("I")("G")("O")("P") - ("S")("P")("A")("C")("I")("N")("G")("1")(parameter_code+9);@/ -load13("B")("I")("G")("O")("P") - ("S")("P")("A")("C")("I")("N")("G")("2")(parameter_code+10);@/ -load13("B")("I")("G")("O")("P") - ("S")("P")("A")("C")("I")("N")("G")("3")(parameter_code+11);@/ -load13("B")("I")("G")("O")("P") - ("S")("P")("A")("C")("I")("N")("G")("4")(parameter_code+12);@/ -load13("B")("I")("G")("O")("P") - ("S")("P")("A")("C")("I")("N")("G")("5")(parameter_code+13);@/ - -@ When a left parenthesis has been scanned, the following routine -is used to interpret the keyword that follows, and to store the -equivalent value in |cur_code|. - -@p procedure get_name; -begin incr(loc); incr(level); {pass the left parenthesis} -cur_char:=" "; -while cur_char=" " do get_next; -if (cur_char>")")or(cur_char<"(") then decr(loc); {back up one character} -name_length:=0; get_keyword_char; {prepare to scan the name} -while cur_char<>" " do begin - if name_length=longest_name then cur_name[1]:="X" {force error} - else incr(name_length); - cur_name[name_length]:=cur_char; - get_keyword_char; - end; -lookup; -if name_ptr=0 then err_print('Sorry, I don''t know that property name'); -@.Sorry, I don't know...@> -cur_code:=equiv[name_ptr]; -end; - -@* Scanning numeric data. -The next thing we need is a trio of subroutines to read the one-byte, -four-byte, and real numbers that may appear as property values. -These subroutines are careful to stick to numbers between $-2^{31}$ -and $2^{31}-1$, inclusive, so that a computer with two's complement -32-bit arithmetic will not be interrupted by overflow. - -@ The first number scanner, which returns a one-byte value, surely has -no problems of arithmetic overflow. - -@p function get_byte:byte; {scans a one-byte property value} -var acc:integer; {an accumulator} -@!t:ASCII_code; {the type of value to be scanned} -begin repeat get_next; -until cur_char<>" "; {skip the blanks before the type code} -t:=cur_char; acc:=0; -repeat get_next; -until cur_char<>" "; {skip the blanks after the type code} -if t="C" then @<Scan an ASCII character code@> -else if t="D" then @<Scan a small decimal number@> -else if t="O" then @<Scan a small octal number@> -else if t="H" then @<Scan a small hexadecimal number@> -else if t="F" then @<Scan a face code@> -else skip_error('You need "C" or "D" or "O" or "H" or "F" here'); -@.You need "C" or "D" ...here@> -cur_char:=" "; get_byte:=acc; -end; - -@ The |get_next| routine converts lower case to upper case, but it leaves -the character in the buffer, so we can unconvert it. - -@<Scan an ASCII...@>= -if (cur_char>=@'41)and(cur_char<=@'176)and - ((cur_char<"(")or(cur_char>")")) then - acc:=xord[buffer[loc]] -else skip_error('"C" value must be standard ASCII and not a paren') -@:C value}\.{"C" value must be...@> - -@ @<Scan a small dec...@>= -begin while (cur_char>="0")and(cur_char<="9") do begin - acc:=acc*10+cur_char-"0"; - if acc>65535 then begin - skip_error('This value shouldn''t exceed 65535'); -@.This value shouldn't...@> - acc:=0; cur_char:=" "; - end - else get_next; - end; -backup; -end - -@ @<Scan a small oct...@>= -begin while (cur_char>="0")and(cur_char<="7") do begin - acc:=acc*8+cur_char-"0"; - if acc>65535 then begin - skip_error('This value shouldn''t exceed ''177777'); -@.This value shouldn't...@> - acc:=0; cur_char:=" "; - end - else get_next; - end; -backup; -end - -@ @<Scan a small hex...@>= -begin while ((cur_char>="0")and(cur_char<="9"))or - ((cur_char>="A")and(cur_char<="F")) do begin - if cur_char>="A" then cur_char:=cur_char+"0"+10-"A"; - acc:=acc*16+cur_char-"0"; - if acc>65535 then begin - skip_error('This value shouldn''t exceed "FFFF'); -@.This value shouldn't...@> - acc:=0; cur_char:=" "; - end - else get_next; - end; -backup; -end - -@ @<Scan a face...@>= -begin if cur_char="B" then acc:=2 -else if cur_char="L" then acc:=4 -else if cur_char<>"M" then acc:=18; -get_next; -if cur_char="I" then incr(acc) -else if cur_char<>"R" then acc:=18; -get_next; -if cur_char="C" then acc:=acc+6 -else if cur_char="E" then acc:=acc+12 -else if cur_char<>"R" then acc:=18; -if acc>=18 then begin - skip_error('Illegal face code, I changed it to MRR'); -@.Illegal face code...@> - acc:=0; - end; -end - -@ The routine that scans a four-byte value puts its output into |cur_bytes|, -which is a record containing (yes, you guessed it) four bytes. - -@<Types...@>= -@!four_bytes=record @!b0:byte;@+@!b1:byte;@+@!b2:byte;@+@!b3:byte;@+end; - -@ @d c0==cur_bytes.b0 -@d c1==cur_bytes.b1 -@d c2==cur_bytes.b2 -@d c3==cur_bytes.b3 - -@<Glob...@>= -@!cur_bytes:four_bytes; {a four-byte accumulator} -@!zero_bytes:four_bytes; {four bytes all zero} - -@ @<Set init...@>= -zero_bytes.b0:=0; zero_bytes.b1:=0; zero_bytes.b2:=0; zero_bytes.b3:=0; - -@ Since the |get_four_bytes| routine is used very infrequently, no attempt -has been made to make it fast; we only want it to work. -This is no longer the case, but we hope it's not too slow. - -@p procedure get_four_bytes; {scans an unsigned constant and sets |four_bytes|} -var c:integer; {local two-byte accumulator} -@!r:integer; {radix} -begin repeat get_next; -until cur_char<>" "; {skip the blanks before the type code} -r:=0; cur_bytes:=zero_bytes; {start with the accumulator zero} -if cur_char="H" then r:=16 -else if cur_char="O" then r:=8 -else if cur_char="D" then r:=10 -else skip_error('Decimal ("D"), octal ("O"), or hex ("H") value needed here'); -@.Decimal ("D"), octal ("O"), or hex...@> -if r>0 then begin - repeat get_next; - until cur_char<>" "; {skip the blanks after the type code} - while ((cur_char>="0")and(cur_char<="9"))or@| - ((cur_char>="A")and(cur_char<="F")) do - @<Multiply by |r|, add |cur_char-"0"|, and |get_next|@>; - end; -end; - -function get_integer:integer; {scans an integer property value} -begin get_four_bytes; -get_integer:=(c0*@"1000000)+(c1*@"10000)+(c2*@"100)+c3; -end; - - -@ @<Multiply by |r|...@>= -begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A"; -if cur_char>="0"+r then skip_error('Illegal digit') -@.Illegal digit@> -else begin - c:=c3*r+cur_char-"0"; c3:=c mod 256;@/ - c:=c2*r+c div 256; c2:=c mod 256;@/ - c:=c1*r+c div 256; c1:=c mod 256;@/ - c:=c0*r+c div 256; - if c<256 then c0:=c - else begin - cur_bytes:=zero_bytes; - if r=8 then - skip_error('Sorry, the maximum octal value is O 37777777777') -@.Sorry, the maximum...@> - else if r=10 then - skip_error('Sorry, the maximum decimal value is D 4294967295') - else skip_error('Sorry, the maximum hex value is H FFFFFFFF'); - end; - get_next; - end; -end - -@ The remaining scanning routine is the most interesting. It scans a real -constant and returns the nearest |fix_word| approximation to that constant. -A |fix_word| is a 32-bit integer that represents a real value that -has been multiplied by $2^{20}$. Since \.{VPtoVF} restricts the magnitude -of reals to 2048, the |fix_word| will have a magnitude less than $2^{31}$. - -@d unity==@'4000000 {$2^{20}$, the |fix_word| 1.0} - -@<Types...@>= -@!fix_word=integer; {a scaled real value with 20 bits of fraction} -@!unsigned_integer=integer; - -@ When a real value is desired, we might as well treat `\.D' and `\.R' -formats as if they were identical. - -@p function get_fix:fix_word; {scans a real property value} -var negative:boolean; {was there a minus sign?} -@!acc:integer; {an accumulator} -@!int_part:integer; {the integer part} -@!j:0..7; {the number of decimal places stored} -begin repeat get_next; -until cur_char<>" "; {skip the blanks before the type code} -negative:=false; acc:=0; {start with the accumulators zero} -if (cur_char<>"R")and(cur_char<>"D") then - skip_error('An "R" or "D" value is needed here') -@.An "R" or "D" ... needed here@> -else begin @<Scan the blanks and/or signs after the type code@>; - while (cur_char>="0") and (cur_char<="9") do - @<Multiply by 10, add |cur_char-"0"|, and |get_next|@>; - int_part:=acc; acc:=0; - if cur_char="." then @<Scan the fraction part and put it in |acc|@>; - if (acc>=unity)and(int_part=2047) then - skip_error('Real constants must be less than 2048') -@.Real constants must be...@> - else acc:=int_part*unity+acc; - end; -if negative then get_fix:=-acc@+else get_fix:=acc; -end; - -@ @<Scan the blanks...@>= -repeat get_next; -if cur_char="-" then begin - cur_char:=" "; negative:=true; - end -else if cur_char="+" then cur_char:=" "; -until cur_char<>" " - -@ @<Multiply by 10...@>= -begin acc:=acc*10+cur_char-"0"; -if acc>=2048 then begin - skip_error('Real constants must be less than 2048'); -@.Real constants must be...@> - acc:=0; cur_char:=" "; - end -else get_next; -end - -@ To scan the fraction $.d_1d_2\ldots\,$, we keep track of up to seven -of the digits $d_j$. A correct result is obtained if we first compute -$f^\prime=\lfloor 2^{21}(d_1\ldots d_j)/10^j\rfloor$, after which -$f=\lfloor(f^\prime+1)/2\rfloor$. It is possible to have $f=1.0$. - -@<Glob...@>= -@!fraction_digits:array[1..7] of integer; {$2^{21}$ times $d_j$} - -@ @<Scan the frac...@>= -begin j:=0; get_next; -while (cur_char>="0")and(cur_char<="9") do begin - if j<7 then begin - incr(j); fraction_digits[j]:=@'10000000*(cur_char-"0"); - end; - get_next; - end; -acc:=0; -while j>0 do begin - acc:=fraction_digits[j]+(acc div 10); decr(j); - end; -acc:=(acc+10) div 20; -end - -@* Storing the property values. -When property values have been found, they are squirreled away in a bunch -of arrays. The header information is unpacked into bytes in an array -called |header_bytes|. The ligature/kerning program is stored in an array -of type |four_bytes|. -Another |four_bytes| array holds the specifications of extensible characters. -The kerns and parameters are stored in separate arrays of |fix_word| values. -Virtual font data goes into an array |vf| of single-byte values. - -We maintain information about at most |max_font+1| local fonts. - -Instead of storing the design size in the header array, we will keep it -in a |fix_word| variable until the last minute. The number of units in the -design size is also kept in a |fix_word|. - -@<Glob...@>= -@!header_bytes:array[header_index] of byte; {the header block} -@!header_ptr:header_index; {the number of header bytes in use} -@!design_size:fix_word; {the design size} -@!design_units:fix_word; {reciprocal of the scaling factor} -@!frozen_du:boolean; {have we used |design_units| irrevocably?} -@!seven_bit_safe_flag:boolean; {does the file claim to be seven-bit-safe?} -@!lig_kern:array[0..max_lig_steps] of four_bytes; {the ligature program} -@!nl:unsigned_integer; {the number of ligature/kern instructions so far} -@!min_nl:unsigned_integer; {the final value of |nl| must be at least this} -@!kern:array[0..max_kerns] of fix_word; {the distinct kerning amounts} -@!nk:0..max_kerns; {the number of entries of |kern|} -@!exten:array[char_type] of four_bytes; {extensible character specs} -@!ne:xchar_type; {the number of extensible characters} -@!param:array[1..max_param_words] of fix_word; {\.{FONTDIMEN} parameters} -@!np:0..max_param_words; {the largest parameter set nonzero} -@!check_sum_specified:boolean; {did the user name the check sum?} -@!bchar:xchar_type; {right boundary character, |xmax_char| if unspecified} -@!font_dir:integer; {font direction} -@!vf:array[0..vf_size] of byte; {stored bytes for \.{VF} file} -@!vf_ptr:0..vf_size; {first unused location in |vf|} -@!vtitle_start:0..vf_size; {starting location of \.{VTITLE} string} -@!vtitle_length:byte; {length of \.{VTITLE} string} -@!packet_start:array[char_type] of 0..vf_size; - {beginning location of character packet} -@!packet_length:array[char_type] of integer; {length of character packet} -@!font_ptr:xfont_type; {number of distinct local fonts seen} -@!cur_font:xfont_type; {number of the current local font} -@!fname_start:array[font_type] of 0..vf_size; {beginning of local font name} -@!fname_length:array[font_type] of byte; {length of local font name} -@!farea_start:array[font_type] of 0..vf_size; {beginning of local font area} -@!farea_length:array[font_type] of byte; {length of local font area} -@!font_checksum:array[font_type] of four_bytes; {local font checksum} -@!font_number:array[xfont_type] of integer; {local font id number} -@!font_at:array[font_type] of fix_word; {local font ``at size''} -@!font_dsize:array[font_type] of fix_word; {local font design size} - -@ @<Types...@>= -@!char_type=0..max_char; -@!xchar_type=0..xmax_char; -@!xxchar_type=0..xxmax_char; -@!font_type=0..max_font; -@!xfont_type=0..xmax_font; -@!header_index=0..max_header_bytes; -@!indx=xxchar_type; - -@ @<Local...@>= -@!d:header_index; {an index into |header_bytes|} - -@ We start by setting up the default values. - -@d check_sum_loc=0 -@d design_size_loc=4 -@d coding_scheme_loc=8 -@d family_loc=coding_scheme_loc+40 -@d seven_flag_loc=family_loc+20 -@d face_loc=seven_flag_loc+3 - -@<Set init...@>= -for d:=0 to 18*4-1 do header_bytes[d]:=0; -header_bytes[8]:=11; header_bytes[9]:="U"; -header_bytes[10]:="N"; -header_bytes[11]:="S"; -header_bytes[12]:="P"; -header_bytes[13]:="E"; -header_bytes[14]:="C"; -header_bytes[15]:="I"; -header_bytes[16]:="F"; -header_bytes[17]:="I"; -header_bytes[18]:="E"; -header_bytes[19]:="D"; -@.UNSPECIFIED@> -for d:=family_loc to family_loc+11 do header_bytes[d]:=header_bytes[d-40]; -design_size:=10*unity; design_units:=unity; frozen_du:=false; -seven_bit_safe_flag:=false;@/ -header_ptr:=18*4; nl:=0; min_nl:=0; nk:=0; ne:=0; np:=0;@/ -check_sum_specified:=false; bchar:=xmax_char;@/ -font_dir:=0; -vf_ptr:=0; vtitle_start:=0; vtitle_length:=0; font_ptr:=0; -for k:=0 to max_char do packet_start[k]:=vf_size; -for k:=0 to 127 do packet_length[k]:=1; -for k:=128 to 255 do packet_length[k]:=2; -for k:=256 to max_char do packet_length[k]:=3; - -@ Most of the dimensions, however, go into the |memory| array. There are -at most |max_char+2| widths, |max_char+2| heights, -|max_char+2| depths, and |max_char+2| italic corrections, -since the value 0 is required but it need not be used. So |memory| has room -for |4*max_char+8| entries, each of which is a |fix_word|. An auxiliary table called -|link| is used to link these words together in linear lists, so that -sorting and other operations can be done conveniently. - -We also add four ``list head'' words to the |memory| and |link| arrays; -these are in locations |width| through |italic|, i.e., 1 through 4. -For example, |link[height]| points to the smallest element in -the sorted list of distinct heights that have appeared so far, and -|memory[height]| is the number of distinct heights. - -@<Types...@>= -@!pointer=0..mem_size; {an index into memory} - -@ The arrays |char_wd|, |char_ht|, |char_dp|, and |char_ic| contain -pointers to the |memory| array entries where the corresponding dimensions -appear. Two other arrays, |char_tag| and |char_remainder|, hold -the other information that \.{TFM} files pack into a |char_info_word|. - -@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} -@d bchar_label==char_remainder[xmax_char] - {beginning of ligature program for left boundary} - -@<Glob...@>= -@!memory:array[pointer] of fix_word; {character dimensions and kerns} -@!mem_ptr:pointer; {largest |memory| word in use} -@!link:array[pointer] of pointer; {to make lists of |memory| items} -@!char_wd:array[char_type] of pointer; {pointers to the widths} -@!char_ht:array[char_type] of pointer; {pointers to the heights} -@!char_dp:array[char_type] of pointer; {pointers to the depths} -@!char_ic:array[char_type] of pointer; {pointers to italic corrections} -@!char_tag:array[char_type] of no_tag..ext_tag; {character tags} -@!char_remainder:array[xchar_type] of xchar_type; - {pointers to ligature labels, - next larger characters, or extensible characters} -@!top_width,@!top_height,@!top_depth,@!top_italic:integer; - -@ @<Local...@>= -@!c:integer; {runs through all character codes} - -@ @<Set init...@>= -bchar_label:=xmax_label; -for c:=0 to max_char do begin - char_wd[c]:=0; char_ht[c]:=0; char_dp[c]:=0; char_ic[c]:=0;@/ - char_tag[c]:=no_tag; char_remainder[c]:=0; - end; -memory[0]:=@'17777777777; {an ``infinite'' element at the end of the lists} -memory[width]:=0; link[width]:=0; {width list is empty} -memory[height]:=0; link[height]:=0; {height list is empty} -memory[depth]:=0; link[depth]:=0; {depth list is empty} -memory[italic]:=0; link[italic]:=0; {italic list is empty} -mem_ptr:=italic; - -@ As an example of these data structures, let us consider the simple -routine that inserts a potentially new element into one of the dimension -lists. The first parameter indicates the list head (i.e., |h=width| for -the width list, etc.); the second parameter is the value that is to be -inserted into the list if it is not already present. The procedure -returns the value of the location where the dimension appears in |memory|. -The fact that |memory[0]| is larger than any legal dimension makes the -algorithm particularly short. - -We do have to handle two somewhat subtle situations. A width of zero must be -put into the list, so that a zero-width character in the font will not appear -to be nonexistent (i.e., so that its |char_wd| index will not be zero), but -this does not need to be done for heights, depths, or italic corrections. -Furthermore, it is necessary to test for memory overflow even though we -have provided room for the maximum number of different dimensions in any -legal font, since the \.{VPL} file might foolishly give any number of -different sizes to the same character. - -@p function sort_in(@!h:pointer;@!d:fix_word):pointer; {inserts into list} -var p:pointer; {the current node of interest} -begin if (d=0)and(h<>width) then sort_in:=0 -else begin p:=h; - while d>=memory[link[p]] do p:=link[p]; - if (d=memory[p])and(p<>h) then sort_in:=p - else if mem_ptr=mem_size then begin - err_print('Memory overflow: too many widths, etc'); -@.Memory overflow...@> - print_ln('Congratulations! It''s hard to make this error.'); - sort_in:=p; - end - else begin - incr(mem_ptr); memory[mem_ptr]:=d; - link[mem_ptr]:=link[p]; link[p]:=mem_ptr; incr(memory[h]); - sort_in:=mem_ptr; - end; - end; -end; - -@ When these lists of dimensions are eventually written to the \.{OFM} -file, we may have to do some rounding of values, because the \.{OFM} file -allows at most 65536 widths, 256 heights, 256 depths, and 256 italic -corrections. The following procedure takes a given list head |h| and a -given dimension |d|, and returns the minimum $m$ such that the elements -of the list can be covered by $m$ intervals of width $d$. It also sets -|next_d| to the smallest value $d^\prime>d$ such that the covering found -by this procedure would be different. In particular, if $d=0$ it computes -the number of elements of the list, and sets |next_d| to the smallest -distance between two list elements. (The covering by intervals of width -|next_d| is not guaranteed to have fewer than $m$ elements, but in -practice this seems to happen most of the time.) - -@<Glob...@>= -@!next_d:fix_word; {the next larger interval that is worth trying} - -@ Once again we can make good use of the fact that |memory[0]| is ``infinite.'' - -@p function min_cover(@!h:pointer;@!d:fix_word):integer; -var p:pointer; {the current node of interest} -@!l:fix_word; {the least element covered by the current interval} -@!m:integer; {the current size of the cover being generated} -begin m:=0; p:=link[h]; next_d:=memory[0]; -while p<>0 do begin - incr(m); l:=memory[p]; - while memory[link[p]]<=l+d do p:=link[p]; - p:=link[p]; - if memory[p]-l<next_d then next_d:=memory[p]-l; - end; -min_cover:=m; -end; - -@ The following procedure uses |min_cover| to determine the smallest $d$ -such that a given list can be covered with at most a given number of -intervals. - -@p function shorten(@!h:pointer;m:integer):fix_word; {finds best way to round} -var d:fix_word; {the current trial interval length} -@!k:integer; {the size of a minimum cover} -begin if memory[h]>m then begin - excess:=memory[h]-m; - k:=min_cover(h,0); d:=next_d; {now the answer is at least |d|} - repeat d:=d+d; k:=min_cover(h,d); - until k<=m; {first we ascend rapidly until finding the range} - d:=d div 2; k:=min_cover(h,d); {now we run through the feasible steps} - while k>m do begin - d:=next_d; k:=min_cover(h,d); - end; - shorten:=d; - end -else shorten:=0; -end; - -@ When we are nearly ready to output the \.{TFM} file, we will set -|index[p]:=k| if the dimension in |memory[p]| is being rounded to the -|k|th element of its list. - -@<Glob...@>= -@!index:array[pointer] of byte; -@!excess:byte; {number of words to remove, if list is being shortened} - -@ Here is the procedure that sets the |index| values. It also shortens -the list so that there is only one element per covering interval; -the remaining elements are the midpoints of their clusters. - -@p procedure set_indices(@!h:pointer;@!d:fix_word); {reduces and indexes a list} -var p:pointer; {the current node of interest} -@!q:pointer; {trails one step behind |p|} -@!m:byte; {index number of nodes in the current interval} -@!l:fix_word; {least value in the current interval} -begin q:=h; p:=link[q]; m:=0; -while p<>0 do begin - incr(m); l:=memory[p]; index[p]:=m; - while memory[link[p]]<=l+d do begin - p:=link[p]; index[p]:=m; decr(excess); - if excess=0 then d:=0; - end; - link[q]:=p; memory[p]:=l+(memory[p]-l) div 2; q:=p; p:=link[p]; - end; -memory[h]:=m; -end; - -@* The input phase. -We're ready now to read and parse the \.{VPL} file, storing property -values as we go. - -@<Glob...@>= -@!c:integer; {the current character or byte being processed} -@!cprime:char_type; {Processing for several characters together} -@!crange:char_type; {ditto} -@!x:fix_word; {current dimension of interest} -@!k:integer; {general-purpose index} - -@ @<Read all the input@>= -cur_char:=" "; -repeat while cur_char=" " do get_next; -if cur_char="(" then @<Read a font property value@> -else if (cur_char=")")and not input_has_ended then begin - err_print('Extra right parenthesis'); - incr(loc); cur_char:=" "; - end -@.Extra right parenthesis@> -else if not input_has_ended then junk_error; -until input_has_ended - -@ The |junk_error| routine just referred to is called when something -appears in the forbidden area between properties of a property list. - -@p procedure junk_error; {gets past no man's land} -begin err_print('There''s junk here that is not in parentheses'); -@.There's junk here...@> -skip_to_paren; -end; - -@ For each font property, we are supposed to read the data from the -left parenthesis that is the current value of |cur_char| to the right -parenthesis that matches it in the input. The main complication is -to recover with reasonable grace from various error conditions that -might arise. - -@<Read a font property value@>= -begin get_name; -if cur_code=comment_code then skip_to_end_of_item -else if (cur_code<110) and (cur_code>character_code) then - flush_error('This property name doesn''t belong on the outer level') -else if (cur_code>=110) and ((cur_code mod 10)<>0) then - flush_error('This property name doesn''t belong on the outer level') -@.This property name doesn't belong...@> -else begin - @<Read the font property value specified by |cur_code|@>; - finish_the_property; - end; -end - -@ @<Read the font property value spec...@>= -case cur_code of -check_sum_code: begin check_sum_specified:=true; read_four_bytes(check_sum_loc); - end; -design_size_code: @<Read the design size@>; -design_units_code: @<Read the design units@>; -coding_scheme_code: read_BCPL(coding_scheme_loc,40); -family_code: read_BCPL(family_loc,20); -face_code: begin c:=get_byte; if c>255 then begin - err_print('FACE clipped to 255'); c:=255 end; - header_bytes[face_loc]:=c - end; -seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>; -header_code: @<Read an indexed header word@>; -font_dimen_code: @<Read font parameter list@>; -lig_table_code: read_lig_kern; -boundary_char_code: bchar:=get_byte; -virtual_title_code: begin vtitle_start:=vf_ptr; copy_to_end_of_item; - if vf_ptr>vtitle_start+255 then begin - err_print('VTITLE clipped to 255 characters'); vtitle_length:=255; -@.VTITLE clipped...@> - end - else vtitle_length:=vf_ptr-vtitle_start; - end; -map_font_code:@<Read a local font list@>; -character_code: read_char_info; -ofm_level_code: @<Read OFM level code@>; -font_dir_code: @<Read font direction code@>; -n_font_dir_code: @<Read natural font direction code@>; -char_repeat_code: read_repeated_character_info; -font_rule_code: read_font_rule_list; -font_glue_code: read_font_glue_list; -font_penalty_code: read_font_penalty_list; -font_mvalue_code: read_font_mvalue_list; -font_fvalue_code: read_font_fvalue_list; -font_ivalue_code: read_font_ivalue_list; -end - -@ The |case| statement just given makes use of three subroutines that we -haven't defined yet. The first of these puts a 32-bit octal quantity -into four specified bytes of the header block. - -@p procedure read_four_bytes(l:header_index); -begin get_four_bytes; -header_bytes[l]:=c0; -header_bytes[l+1]:=c1; -header_bytes[l+2]:=c2; -header_bytes[l+3]:=c3; -end; - -@ The second little procedure is used to scan a string and to store it in -the ``{\mc BCPL} format'' required by \.{TFM} files. The string is supposed -to contain at most |n| bytes, including the first byte (which holds the -length of the rest of the string). - -@p procedure read_BCPL(l:header_index;n:byte); -var k:header_index; -begin k:=l; -while cur_char=" " do get_next; -while (cur_char<>"(")and(cur_char<>")") do begin - if k<l+n then incr(k); - if k<l+n then header_bytes[k]:=cur_char; - get_next; - end; -if k=l+n then begin - err_print('String is too long; its first ',n-1:1, -@.String is too long...@> - ' characters will be kept'); decr(k); - end; -header_bytes[l]:=k-l; -while k<l+n-1 do begin {tidy up the remaining bytes by setting them to nulls} - incr(k); header_bytes[k]:=0; - end; -end; - -@ @<Read the design size@>= -begin next_d:=get_fix; -if next_d<unity then - err_print('The design size must be at least 1') -@.The design size must...@> -else design_size:=next_d; -end - -@ @<Read the design units@>= -begin next_d:=get_fix; -if next_d<=0 then - err_print('The number of units per design size must be positive') -@.The number of units...@> -else if frozen_du then - err_print('Sorry, it''s too late to change the design units') -@.Sorry, it's too late...@> -else design_units:=next_d; -end - -@ @<Read the seven-bit-safe...@>= -begin while cur_char=" " do get_next; -if cur_char="T" then seven_bit_safe_flag:=true -else if cur_char="F" then seven_bit_safe_flag:=false -else err_print('The flag value should be "TRUE" or "FALSE"'); -@.The flag value should be...@> -skip_to_paren; -end - -@ @<Read an indexed header word@>= -begin c:=get_byte; -if c<18 then skip_error('HEADER indices should be 18 or more') -@.HEADER indices...@> -else if 4*c+4>max_header_bytes then - skip_error('This HEADER index is too big for my present table size') -@.This HEADER index is too big...@> -else begin - while header_ptr<4*c+4 do begin - header_bytes[header_ptr]:=0; incr(header_ptr); - end; - read_four_bytes(4*c); - end; -end - -@ The remaining kinds of font property values that need to be read are -those that involve property lists on higher levels. Each of these has a -loop similar to the one that was used at level zero. Then we put the -right parenthesis back so that `|finish_the_property|' will be happy; -there is probably a more elegant way to do this. - -@d finish_inner_property_list==begin decr(loc); incr(level); cur_char:=")"; - end - -@<Read font parameter list@>= -begin while level=1 do - begin while cur_char=" " do get_next; - if cur_char="(" then @<Read a parameter value@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a parameter value@>= -begin get_name; -if cur_code=comment_code then skip_to_end_of_item -else if (cur_code<parameter_code)or(cur_code>=char_wd_code) then - flush_error('This property name doesn''t belong in a FONTDIMEN list') -@.This property name doesn't belong...@> -else begin if cur_code=parameter_code then c:=get_integer - else c:=cur_code-parameter_code; - if c=0 then flush_error('PARAMETER index must not be zero') -@.PARAMETER index must not...@> - else if c>max_param_words then - flush_error('This PARAMETER index is too big for my present table size') -@.This PARAMETER index is too big...@> - else begin - while np<c do begin - incr(np); param[np]:=0; - end; - param[c]:=get_fix; - finish_the_property; - end; - end; -end - -@ @<Read a local font list@>= -begin font_number[font_ptr]:=get_integer; cur_font:=0; -while font_number[font_ptr]<>font_number[cur_font] do incr(cur_font); -if cur_font=font_ptr then {it's a new font number} - if font_ptr<xmax_font then @<Initialize a new local font@> - else err_print('Sorry, too many different mapfonts'); -@.Sorry, too many different mapfonts@> -if cur_font=font_ptr then skip_to_end_of_item -else while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a local font property@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Initialize a new local font@>= -begin incr(font_ptr); -fname_start[cur_font]:=vf_size; fname_length[cur_font]:=4; {\.{NULL}} -farea_start[cur_font]:=vf_size; farea_length[cur_font]:=0; -font_checksum[cur_font]:=zero_bytes; -font_at[cur_font]:=@'4000000; {denotes design size of this virtual font} -font_dsize[cur_font]:=@'50000000; {the |fix_word| for 10} -end - -@ @<Read a local font property@>= -begin get_name; -if cur_code=comment_code then skip_to_end_of_item -else if (cur_code<font_name_code)or(cur_code>font_dsize_code) then - flush_error('This property name doesn''t belong in a MAPFONT list') -@.This property name doesn't belong...@> -else begin - case cur_code of - font_name_code:@<Read a local font name@>; - font_area_code:@<Read a local font area@>; - font_checksum_code:begin - get_four_bytes; font_checksum[cur_font]:=cur_bytes; - end; - font_at_code: begin frozen_du:=true; - if design_units=unity then font_at[cur_font]:=get_fix - else font_at[cur_font]:=round((get_fix/design_units)*1048576.0); - end; - font_dsize_code:font_dsize[cur_font]:=get_fix; - end; {there are no other cases} - finish_the_property; - end; -end - -@ @<Read a local font name@>= -begin fname_start[cur_font]:=vf_ptr; copy_to_end_of_item; -if vf_ptr>fname_start[cur_font]+255 then begin - err_print('FONTNAME clipped to 255 characters'); -@.FONTNAME clipped...@> - fname_length[cur_font]:=255; - end -else fname_length[cur_font]:=vf_ptr-fname_start[cur_font]; -end - -@ @<Read a local font area@>= -begin farea_start[cur_font]:=vf_ptr; copy_to_end_of_item; -if vf_ptr>farea_start[cur_font]+255 then begin - err_print('FONTAREA clipped to 255 characters'); -@.FONTAREA clipped...@> - farea_length[cur_font]:=255; - end -else farea_length[cur_font]:=vf_ptr-farea_start[cur_font]; -end - -@ @<Read ligature/kern list@>= -begin lk_step_ended:=false; -while level=1 do - begin while cur_char=" " do get_next; - if cur_char="(" then read_lig_kern_command - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a ligature/kern command@>= -begin get_name; -if cur_code=comment_code then skip_to_end_of_item -else if (cur_code>=label_code) and (cur_code<=(lig_code+11)) then begin - case cur_code of - label_code:@<Read a label step@>; - stop_code:@<Read a stop step@>; - skip_code:@<Read a skip step@>; - krn_code:@<Read a kerning step@>; - lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5,lig_code+6, - lig_code+7,lig_code+11:@<Read a ligature step@>; - end; {there are no other cases |>=label_code|} - finish_the_property; - end -else if (cur_code>=clabel_code) and (cur_code<=cpenglue_code) then begin - case cur_code of - clabel_code:@<Read an extended label step@>; - cpen_code:@<Read an extended penalty step@>; - cglue_code:@<Read an extended glue step@>; - cpenglue_code:@<Read an extended penalty/glue step@>; - ckrn_code:@<Read an extended kern step@>; - end; {there are no other cases |>=label_code|} - finish_the_property; - end -else flush_error('This property name doesn''t belong in a LIGTABLE list'); -@.This property name doesn't belong...@> -end - -@ When a character is about to be tagged, we call the following -procedure so that an error message is given in case of multiple tags. - -@p procedure check_tag(c:byte); {print error if |c| already tagged} -begin case char_tag[c] of -no_tag: do_nothing; -lig_tag: err_print('This character already appeared in a LIGTABLE LABEL'); -@.This character already...@> -list_tag: err_print('This character already has a NEXTLARGER spec'); -ext_tag: err_print('This character already has a VARCHAR spec'); -end; -end; - -@ @<Read a label step@>= -begin while cur_char=" " do get_next; -if cur_char="B" then begin - bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}} - end -else begin - backup; c:=get_byte; - check_tag(c); char_tag[c]:=lig_tag; char_remainder[c]:=nl; - end; -if min_nl<=nl then min_nl:=nl+1; -lk_step_ended:=false; -end - -@ @d stop_flag=128 {value indicating `\.{STOP}' in a lig/kern program} -@d kern_flag=128 {op code for a kern step} - -@<Globals...@>= -@!lk_step_ended:boolean; - {was the last \.{LIGTABLE} property \.{LIG} or \.{KRN}?} -@!krn_ptr:0..max_kerns; {an index into |kern|} - -@ @<Read a stop step@>= -if not lk_step_ended then - err_print('STOP must follow LIG or KRN') -@.STOP must follow LIG or KRN@> -else begin - lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag; - lk_step_ended:=false; - end - -@ @<Read a skip step@>= -if not lk_step_ended then - err_print('SKIP must follow LIG or KRN') -@.SKIP must follow LIG or KRN@> -else begin - c:=get_byte; - if c>=128 then err_print('Maximum SKIP amount is 127') -@.Maximum SKIP amount...@> - else if nl+c>=max_lig_steps then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> - else begin - lig_kern[nl-1].b0:=c; - if min_nl<=nl+c then min_nl:=nl+c+1; - end; - lk_step_ended:=false; - end - -@ @<Read a ligature step@>= -begin lig_kern[nl].b0:=0; -lig_kern[nl].b2:=cur_code-lig_code; -lig_kern[nl].b1:=get_byte; -lig_kern[nl].b3:=get_byte; -if nl>=max_lig_steps-1 then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> -else incr(nl); -lk_step_ended:=true; -end - -@ @<Read a kerning step@>= -begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte; -kern[nk]:=get_fix; krn_ptr:=0; -while kern[krn_ptr]<>kern[nk] do incr(krn_ptr); -if krn_ptr=nk then begin - if nk<max_kerns then incr(nk) - else begin - err_print('Sorry, too many different kerns for me to handle'); -@.Sorry, too many different kerns...@> - decr(krn_ptr); - end; - end; -if ofm_level=-1 then begin - lig_kern[nl].b2:=kern_flag+(krn_ptr div 256); - lig_kern[nl].b3:=krn_ptr mod 256; - end -else begin - lig_kern[nl].b2:=kern_flag+(krn_ptr div 65536); - lig_kern[nl].b3:=krn_ptr mod 65536; - end; -if nl>=max_lig_steps-1 then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> -else incr(nl); -lk_step_ended:=true; -end - -@ @<Global...@>= -@!category_remainders:array[0..256] of integer; -@!ivalue_category,@!max_ivalue_category:integer; -@!glue_category,@!max_glue_category:integer; -@!penalty_category,@!max_penalty_category:integer; - -@ @<Set init...@>= -for ivalue_category:=0 to 256 do begin - category_remainders[ivalue_category]:=-1; -end; -max_ivalue_category:=-1; -max_glue_category:=-1; -max_penalty_category:=-1; - -@ @<Read an extended label step@>= -begin -c:=get_byte; -category_remainders[c]:=nl; -if max_ivalue_category<c then max_ivalue_category:=c; -if min_nl<=nl then min_nl:=nl+1; -lk_step_ended:=false; -end - -@ @<Read an extended penalty step@>= -begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte; -lig_kern[nl].b2:=17; -penalty_category:=get_byte; -if max_penalty_category<penalty_category then - max_penalty_category:=penalty_category; -lig_kern[nl].b3:=penalty_category; -if nl>=max_lig_steps-1 then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> -else incr(nl); -lk_step_ended:=true; -end - -@ @<Read an extended glue step@>= -begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte; -lig_kern[nl].b2:=18; -glue_category:=get_byte; -if max_glue_category<glue_category then - max_glue_category:=glue_category; -lig_kern[nl].b3:=glue_category; -if nl>=max_lig_steps-1 then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> -else incr(nl); -lk_step_ended:=true; -end - -@ @<Read an extended penalty/glue step@>= -begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte; -lig_kern[nl].b2:=19; -penalty_category:=get_byte; -if max_penalty_category<penalty_category then - max_penalty_category:=penalty_category; -glue_category:=get_byte; -if max_glue_category<glue_category then - max_glue_category:=glue_category; -lig_kern[nl].b3:=penalty_category*256+glue_category; -if nl>=max_lig_steps-1 then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> -else incr(nl); -lk_step_ended:=true; -end - -@ @<Read an extended kern step@>= -begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte; -lig_kern[nl].b2:=20; -kern[nk]:=get_fix; krn_ptr:=0; -while kern[krn_ptr]<>kern[nk] do incr(krn_ptr); -if krn_ptr=nk then begin - if nk<max_kerns then incr(nk) - else begin - err_print('Sorry, too many different kerns for me to handle'); -@.Sorry, too many different kerns...@> - decr(krn_ptr); - end; - end; -if krn_ptr>65535 then - err_print('Sorry, too many different kerns for me to handle'); -lig_kern[nl].b3:=krn_ptr; -if nl>=max_lig_steps-1 then - err_print('Sorry, LIGTABLE too long for me to handle') -@.Sorry, LIGTABLE too long...@> -else incr(nl); -lk_step_ended:=true; -end - -@ @<Globals...@>= -@!char_extended_tag:array [char_type] of boolean; - -@ @<Set init...@>= -for c:=0 to max_char do - char_extended_tag[c]:=false; - -@ @<Finish up the extended font stuff@>= -begin -if max_penalty_category>0 then begin - if nkp=0 then - err_print('No PENALTY table') - else if npp[0]<max_penalty_category then - err_print('Not enough PENALTY entries'); - end; -if max_glue_category>0 then begin - if nkg=0 then - err_print('No GLUE table') - else if npg[0]<max_glue_category then - err_print('Not enough GLUE entries'); - end; -if max_ivalue_category>0 then begin - if nki=0 then - err_print('No IVALUE table') - else if npi[0]<max_ivalue_category then - err_print('Not enough IVALUE entries') - else begin - for c:=0 to max_char do begin - if (char_wd[c]<>0) then begin - for j:=0 to max_ivalue_category do - if char_table[c,0]=j then begin - if category_remainders[j]<>-1 then begin - if char_tag[c]<>0 then - err_print('Character already has a tag') - else begin - char_extended_tag[c]:=true; - char_remainder[c]:=category_remainders[j]; - end; - end; - end; - end; - end; - end; - end; -end - -@ @<Global...@>= -tables_read:boolean; - -@ @<Set init...@>= -tables_read:=false; - -@ Finally we come to the part of \.{VPtoVF}'s input mechanism -that is used most, the processing of individual character data. - -@<Read character info list@>= -begin -if not tables_read then begin - @<Compute the new header information for OFM files@>; - tables_read:=true; - end; -c:=get_byte; {read the character code that is being specified} -@<Print |c| in hex notation@>; -while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then read_character_property - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|} -finish_inner_property_list; -end - -@ @<Globals...@>= -@!char_original:array [0..max_char] of integer; -@!char_repeats:array [0..max_char] of integer; -@!diff:boolean; -@!needed_space,@!extra_bytes:integer; - -@ @<Set init...@>= -for ch_entry:=0 to max_char do begin - char_original[ch_entry]:=ch_entry; - char_repeats[ch_entry]:=0; - end; - -@ @<Read repeated character info@>= -begin -if not tables_read then begin - compute_new_header_ofm; - tables_read:=true; - end; -c:=get_byte; {read the character code that is being specified} -@<Print |c| in hex notation@>; -crange:=get_byte; {read how many characters are being defined} -if (crange<0) then begin - err_print('Character ranges must be positive'); - crange:=0; - end; -if ((c+crange)>max_char) then begin - err_print('Character range too large'); - crange:=0; - end; -print('-'); print_hex(c+crange); -while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then read_character_property - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize |c|} -finish_inner_property_list; -cprime:=c; -for c:=(cprime+1) to (cprime+crange) do begin - char_wd[c]:=char_wd[cprime]; - char_ht[c]:=char_ht[cprime]; - char_dp[c]:=char_dp[cprime]; - char_ic[c]:=char_ic[cprime]; - for tab:=0 to (nki+nkf+nkr+nkg+nkp-1) do begin - char_table[c,tab]:= char_table[cprime,tab]; - end; - end; -end - -@ Tables for character parameters - -@d char_param_tables==8 - -@<Globals...@>= -@!char_table:array [0..max_char,0..char_param_tables] of integer; -@!ch_table,@!ch_entry:integer; -@!temp_value:integer; - -@ @<Set init...@>= -for c:=0 to max_char do - for ch_table:=0 to char_param_tables do - char_table[c,ch_table]:=0; - -@ @<Read a character property@>= -begin get_name; -if cur_code=comment_code then skip_to_end_of_item -else if (cur_code<char_wd_code) or - ((cur_code>var_char_code) and not - ((cur_code>=char_ivalue_code) and (cur_code<=char_penalty_code))) - then - flush_error('This property name doesn''t belong in a CHARACTER list') -@.This property name doesn't belong...@> -else begin - case cur_code of - char_wd_code:char_wd[c]:=sort_in(width,get_fix); - char_ht_code:char_ht[c]:=sort_in(height,get_fix); - char_dp_code:char_dp[c]:=sort_in(depth,get_fix); - char_ic_code:char_ic[c]:=sort_in(italic,get_fix); - sec_width_code:temp_value:=get_fix; - sec_height_code:temp_value:=get_fix; - sec_depth_code:temp_value:=get_fix; - sec_italic_code:temp_value:=get_fix; - accent_code:temp_value:=get_fix; - prim_top_axis_code:temp_value:=get_fix; - prim_top_axis_bis_code:temp_value:=get_fix; - prim_bot_axis_code:temp_value:=get_fix; - prim_bot_axis_bis_code:temp_value:=get_fix; - prim_mid_hor_code:temp_value:=get_fix; - prim_mid_vert_code:temp_value:=get_fix; - prim_base_slant_code:temp_value:=get_fix; - sec_top_axis_code:temp_value:=get_fix; - sec_top_axis_bis_code:temp_value:=get_fix; - sec_bot_axis_code:temp_value:=get_fix; - sec_bot_axis_bis_code:temp_value:=get_fix; - sec_mid_hor_code:temp_value:=get_fix; - sec_mid_vert_code:temp_value:=get_fix; - sec_base_slant_code:temp_value:=get_fix; - next_larger_code:begin check_tag(c); char_tag[c]:=list_tag; - char_remainder[c]:=get_byte; - end; - map_code:read_packet(c); - var_char_code:@<Read an extensible recipe for |c|@>; - char_ivalue_code: begin - ch_table:=get_integer; - ch_entry:=get_integer; - char_table[c,ch_table]:=ch_entry; - if ch_table>nkci then nkci:=ch_table; - end; - char_fvalue_code: begin - ch_table:=get_integer+nki; - ch_entry:=get_integer; - char_table[c,ch_table]:=ch_entry; - if ch_table>nkcf then nkcf:=ch_table; - end; - char_mvalue_code: begin - ch_table:=get_integer+nki+nkf; - ch_entry:=get_integer; - char_table[c,ch_table]:=ch_entry; - if ch_table>nkcm then nkcm:=ch_table; - end; - char_rule_code: begin - ch_table:=get_integer+nki+nkf+nkm; - ch_entry:=get_integer; - char_table[c,ch_table]:=ch_entry; - if ch_table>nkcr then nkcr:=ch_table; - end; - char_glue_code: begin - ch_table:=get_integer+nki+nkf+nkm+nkr; - ch_entry:=get_integer; - char_table[c,ch_table]:=ch_entry; - if ch_table>nkcg then nkcg:=ch_table; - end; - char_penalty_code: begin - ch_table:=get_integer+nki+nkf+nkm+nkr+nkg; - ch_entry:=get_integer; - char_table[c,ch_table]:=ch_entry; - if ch_table>nkcp then nkcp:=ch_table; - end; - end;@/ - finish_the_property; - end; -end - -@ @<Read an extensible r...@>= -begin if ne=xmax_char then - err_print('Sorry, too many VARCHAR specs') -@.Sorry, too many VARCHAR specs@> -else begin - check_tag(c); char_tag[c]:=ext_tag; char_remainder[c]:=ne;@/ - exten[ne]:=zero_bytes; - while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read an extensible piece@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; - incr(ne); - finish_inner_property_list; - end; -end - -@ @<Read an extensible p...@>= -begin get_name; -if cur_code=comment_code then skip_to_end_of_item -else if (cur_code<var_char_code+1)or(cur_code>var_char_code+4) then - flush_error('This property name doesn''t belong in a VARCHAR list') -@.This property name doesn't belong...@> -else begin - case cur_code-(var_char_code+1) of - 0:exten[ne].b0:=get_byte; - 1:exten[ne].b1:=get_byte; - 2:exten[ne].b2:=get_byte; - 3:exten[ne].b3:=get_byte; - end;@/ - finish_the_property; - end; -end - -@ The input routine is now complete except for the following code, -which prints a progress report as the file is being read. - -@ @<Glob...@>= -@!HEX: packed array [1..32] of char; - -@ @<Set init...@>= -HEX:='0123456789ABCDEF';@/ - -@ The array |dig| will hold a sequence of digits to be output. - -@<Glob...@>= -@!dig:array[0..32] of integer; - -@ Here, in fact, are two procedures that output -|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$. - -@p procedure out_digs(j:integer); {outputs |j| digits} -begin repeat decr(j); out(HEX[1+dig[j]]); - until j=0; -end; -@# -procedure print_digs(j:integer); {prints |j| digits} -begin repeat decr(j); print(HEX[1+dig[j]]); - until j=0; -end; - -@ The |print_number| procedure indicates how |print_digs| can be used. -This procedure can print in octal, decimal or hex notation. - -@d print_hex(#)==print_number(#,16) -@d print_octal(#)==print_number(#,8) -@d print_decimal(#)==print_number(#,10) - -@p procedure print_number(c:integer; form:integer); {prints value of -|c|} -var j:0..32; {index into |dig|} -begin -j:=0; -if (c<0) then begin - print_ln('Internal error: print_number (negative value)'); - c:=0; - end; -if form=8 then - print('''') {an apostrophe indicates the octal notation} -else if form=16 then - print('"') { a double apostrophe indicates the hexadecimal -notation} -else if form<>10 then begin - print_ln('Internal error: print_number (form)'); - form:=16; - end; -while (c>0) or (j=0) do begin - dig[j]:=c mod form; c:=c div form; - j:=j+1; - end; -print_digs(j); -end; - -@ @<Print |c| in hex...@>= -begin if chars_on_line=8 then begin - print_ln(' '); chars_on_line:=1; - end -else begin - if chars_on_line>0 then print(' '); - incr(chars_on_line); - end; -print_hex(c); {progress report} -end - - -@* Assembling the mappings. -Each \.{MAP} property is a sequence of \.{DVI} instructions, for which -we need to know some of the opcodes. -We add afterwards the definitions for outputting typesetting commands. - -@d set_char_0=0 {\.{DVI} command to typeset character 0 and move right} -@d set1=128 {typeset a character and move right} -@d set_rule=132 {typeset a rule and move right} -@d push=141 {save the current positions} -@d pop=142 {restore previous positions} -@d right1=143 {move right} -@d w0=147 {move right by |w|} -@d w1=148 {move right and set |w|} -@d x0=152 {move right by |x|} -@d x1=153 {move right and set |x|} -@d down1=157 {move down} -@d y0=161 {move down by |y|} -@d y1=162 {move down and set |y|} -@d z0=166 {move down by |z|} -@d z1=167 {move down and set |z|} -@d fnt_num_0=171 {set current font to 0} -@d fnt1=235 {set current font} -@d xxx1=239 {extension to \.{DVI} primitives} -@d xxx4=242 {potentially long extension to \.{DVI} primitives} -@d fnt_def1=243 {define the meaning of a font number} -@d pre=247 {preamble} -@d post=248 {postamble beginning} -@d Incr_Decr(#) == # -@d Incr(#) == #:=#+Incr_Decr {increase a variable} - -@d out_four(#) == -if x>=0 then #(x div @"1000000) -else begin Incr(x)(@"40000000); Incr(x)(@"40000000); - #((x div @"1000000) + 128); - end; -x:=x mod @"1000000; #(x div @"10000); -x:=x mod @"10000; #(x div @"100); -#(x mod @"100) - -@d out_cmd(#) == -if (x<@"100)and(x>=0) then begin - if (o<>set1)or(x>127) then - if (o=fnt1)and(x<64) then Incr(x)(fnt_num_0) @+ else #(o); - end -else begin - if (x<@"10000)and(x>=0) then #(o+1) @+ else begin - if (x<@"1000000)and(x>=0) then #(o+2) @+ else begin - #(o+3); - if x>=0 then #(x div @"1000000) - else begin - Incr(x)(@"40000000); Incr(x)(@"40000000); - #((x div @"1000000) + 128); x:=x mod @"1000000; - end; - #(x div @"10000); x:=x mod @"10000; - end; - #(x div @"10000); x:=x mod @"10000; - end; - #(x div @"100); x:=x mod @"100; - end; -#(x) - -@p -procedure vf_store_set(@!x:integer); -var @!o:byte; -begin o:=set1; out_cmd(vf_store); -end; - -procedure vfout_set(@!x:integer); -var @!o:byte; -begin o:=set1; out_cmd(vout); -end; - -procedure vf_store_fnt(@!x:integer); -var @!o:byte; -begin o:=fnt1; out_cmd(vf_store); -end; - -procedure vfout_fntdef(@!x:integer); -var @!o:byte; -begin o:=fnt_def1; out_cmd(vout); -end; - -procedure vfout_char(@!x:integer); -begin out_four(vout); -end; - - -@ We keep stacks of movement values, in order to optimize the \.{DVI} code -in simple cases. - -@<Glob...@>= -@!hstack:array[0..max_stack] of 0..2; {number of known horizontal movements} -@!vstack:array[0..max_stack] of 0..2; {number of known vertical movements} -@!wstack,@!xstack,@!ystack,@!zstack:array[0..max_stack] of fix_word; -@!stack_ptr:0..max_stack; - -@ The packet is built by straightforward assembly of \.{DVI} instructions. - -@p @<Declare the |vf_fix| procedure@>@;@/ -procedure read_packet(@!c:byte); -var @!cc:char_type; {character being typeset} -@!x:fix_word; {movement} -@!h,@!v:0..2; {top of |hstack| and |vstack|} -@!special_start:0..vf_size; {location of |xxx1| command} -@!k:0..vf_size; {loop index} -begin packet_start[c]:=vf_ptr; stack_ptr:=0; h:=0; v:=0; -cur_font:=0; -while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read and assemble a list of \.{DVI} commands@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -while stack_ptr>0 do begin - err_print('Missing POP supplied'); -@.Missing POP supplied@> - vf_store(pop); decr(stack_ptr); - end; -packet_length[c]:=vf_ptr-packet_start[c]; -finish_inner_property_list; -end; - -@ @<Read and assemble a list of \.{DVI}...@>= -begin get_name; -if cur_code=comment_code then skip_to_end_of_item -else if (cur_code<select_font_code)or(cur_code>special_hex_code) then - flush_error('This property name doesn''t belong in a MAP list') -@.This property name doesn't belong...@> -else begin - case cur_code of - select_font_code:@<Assemble a font selection@>; - set_char_code:@<Assemble a typesetting instruction@>; - set_rule_code:@<Assemble a rulesetting instruction@>; - move_right_code,move_right_code+1:@<Assemble a horizontal movement@>; - move_down_code,move_down_code+1:@<Assemble a vertical movement@>; - push_code:@<Assemble a stack push@>; - pop_code:@<Assemble a stack pop@>; - special_code,special_hex_code:@<Assemble a special command@>; - end;@/ - finish_the_property; - end; -end - -@ @<Assemble a font selection@>= -begin font_number[font_ptr]:=get_integer; -cur_font:=0; -while font_number[font_ptr]<>font_number[cur_font] do incr(cur_font); -if cur_font=font_ptr then err_print('Undefined MAPFONT cannot be selected') -@.Undefined MAPFONT...@> -else vf_store_fnt(cur_font); -end - -@ @<Assemble a typesetting instruction@>= -if cur_font=font_ptr then - err_print('Character cannot be typeset in undefined font') -@.Character cannot be typeset...@> -else begin - cc:=get_byte; vf_store_set(cc); - end - -@ Here's a procedure that converts a |fix_word| to a sequence of -\.{DVI} bytes. - -@<Declare the |vf_fix|...@>= -procedure vf_fix(@!opcode:byte;@!x:fix_word); -var negative:boolean; -@!k:0..4; {number of bytes to typeset} -@!t:integer; {threshold} -begin frozen_du:=true; -if design_units<>unity then x:=round((x/design_units)*1048576.0); -if x>0 then negative:=false -else begin negative:=true; x:=-1-x;@+end; -if opcode=0 then begin - k:=4; t:=@'100000000;@+end -else begin - t:=127; k:=1; - while x>t do begin - t:=256*t+255; incr(k); - end; - vf_store(opcode+k-1); t:=t div 128 +1; - end; -repeat if negative then begin - vf_store(255-(x div t)); negative:=false; - x:=(x div t)*t+t-1-x; - end -else vf_store((x div t) mod 256); -decr(k); t:=t div 256; -until k=0; -end; - -@ @<Assemble a rulesetting instruction@>= -begin vf_store(set_rule); vf_fix(0,get_fix); vf_fix(0,get_fix); -end - -@ @<Assemble a horizontal movement@>= -begin if cur_code=move_right_code then x:=get_fix@+else x:=-get_fix; -if h=0 then begin - wstack[stack_ptr]:=x; h:=1; vf_fix(w1,x);@+end -else if x=wstack[stack_ptr] then vf_store(w0) -else if h=1 then begin - xstack[stack_ptr]:=x; h:=2; vf_fix(x1,x);@+end -else if x=xstack[stack_ptr] then vf_store(x0) -else vf_fix(right1,x); -end - -@ @<Assemble a vertical movement@>= -begin if cur_code=move_down_code then x:=get_fix@+else x:=-get_fix; -if v=0 then begin - ystack[stack_ptr]:=x; v:=1; vf_fix(y1,x);@+end -else if x=ystack[stack_ptr] then vf_store(y0) -else if v=1 then begin - zstack[stack_ptr]:=x; v:=2; vf_fix(z1,x);@+end -else if x=zstack[stack_ptr] then vf_store(z0) -else vf_fix(down1,x); -end - -@ @<Assemble a stack push@>= -if stack_ptr=max_stack then {too pushy} - err_print('Don''t push so much---stack is full!') -@.Don't push so much...@> -else begin - vf_store(push); hstack[stack_ptr]:=h; vstack[stack_ptr]:=v; - incr(stack_ptr); h:=0; v:=0; - end - -@ @<Assemble a stack pop@>= -if stack_ptr=0 then - err_print('Empty stack cannot be popped') -@.Empty stack...@> -else begin - vf_store(pop); decr(stack_ptr); - h:=hstack[stack_ptr]; v:=vstack[stack_ptr]; - end - -@ @<Assemble a special command@>= -begin vf_store(xxx1); vf_store(0); {dummy length} -special_start:=vf_ptr; -if cur_code=special_code then copy_to_end_of_item -else begin - repeat x:=get_hex; - if cur_char>")" then vf_store(x*16+get_hex); - until cur_char<=")"; - end; -if vf_ptr-special_start>255 then @<Convert |xxx1| command to |xxx4|@> -else vf[special_start-1]:=vf_ptr-special_start; -end - -@ @<Convert |xxx1|...@>= -if vf_ptr+3>vf_size then begin - err_print('Special command being clipped---no room left!'); -@.Special command being clipped...@> - vf_ptr:=special_start+255; vf[special_start-1]:=255; - end -else begin - for k:=vf_ptr downto special_start do vf[k+3]:=vf[k]; - x:=vf_ptr-special_start; vf_ptr:=vf_ptr+3; - vf[special_start-2]:=xxx4; - vf[special_start-1]:=x div @'100000000; - vf[special_start]:=(x div @'200000) mod 256; - vf[special_start+1]:=(x div @'400) mod 256; - vf[special_start+2]:=x mod 256; - end - -@* The checking and massaging phase. -Once the whole \.{VPL} file has been read in, we must check it for consistency -and correct any errors. This process consists mainly of running through -the characters that exist and seeing if they refer to characters that -don't exist. We also compute the true value of |seven_unsafe|; we make sure -that the charlists and ligature programs contain no loops; and we -shorten the lists of widths, heights, depths, and italic corrections, -if necessary, to keep from exceeding the required maximum sizes. - -@<Glob...@>= -@!seven_unsafe:boolean; {do seven-bit characters generate eight-bit ones?} - -@ @<Correct and check the information@>= -if nl>0 then @<Make sure the ligature/kerning program ends appropriately@>; -seven_unsafe:=false; -for c:=0 to max_char do if char_wd[c]<>0 then - @<For all characters |g| generated by |c|, - make sure that |char_wd[g]| is nonzero, and - set |seven_unsafe| if |c<128<=g|@>; -if bchar_label<xmax_label then begin - c:=xmax_char; @<Check ligature program of |c|@>; - end; -if seven_bit_safe_flag and seven_unsafe then - print_ln('The font is not really seven-bit-safe!'); -@.The font is not...safe@> -@<Check for infinite ligature loops@>; -@<Doublecheck the lig/kern commands and the extensible recipes@>; -finish_extended_font; -for c:=0 to max_char do - @<Make sure that |c| is not the largest element of a charlist cycle@>; -@<Put the width, height, depth, and italic lists into final form@> - -@ The checking that we need in several places is accomplished by three -macros that are only slightly tricky. - -@d existence_tail(#)==begin char_wd[g]:=sort_in(width,0); - print(#,' '); print_hex(c); - print_ln(' had no CHARACTER spec.'); - end; - end -@d check_existence_and_safety(#)==begin g:=#; - if (g>=128)and(c<128) then seven_unsafe:=true; - if char_wd[g]=0 then existence_tail -@d check_existence(#)==begin g:=#; - if char_wd[g]=0 then existence_tail - -@<For all characters |g| generated by |c|...@>= -case char_tag[c] of -no_tag: do_nothing; -lig_tag: @<Check ligature program of |c|@>; -list_tag: check_existence_and_safety(char_remainder[c]) - ('The character NEXTLARGER than'); -@.The character NEXTLARGER...@> -ext_tag:@<Check the pieces of |exten[c]|@>; -end - -@ @<Check the pieces...@>= -begin if exten[char_remainder[c]].b0>0 then - check_existence_and_safety(exten[char_remainder[c]].b0) - ('TOP piece of character'); -@.TOP piece of character...@> -if exten[char_remainder[c]].b1>0 then - check_existence_and_safety(exten[char_remainder[c]].b1) - ('MID piece of character'); -@.MID piece of character...@> -if exten[char_remainder[c]].b2>0 then - check_existence_and_safety(exten[char_remainder[c]].b2) - ('BOT piece of character'); -@.BOT piece of character...@> -check_existence_and_safety(exten[char_remainder[c]].b3) - ('REP piece of character'); -@.REP piece of character...@> -end - -@ @<Make sure that |c| is not the largest element of a charlist cycle@>= -if char_tag[c]=list_tag then begin - g:=char_remainder[c]; - while (g<c)and(char_tag[g]=list_tag) do g:=char_remainder[g]; - if g=c then begin - char_tag[c]:=no_tag; - print('A cycle of NEXTLARGER characters has been broken at '); -@.A cycle of NEXTLARGER...@> - print_hex(c); print_ln('.'); - end; - end - -@ @<Glob...@>= -@!delta:fix_word; {size of the intervals needed for rounding} - -@ @d round_message(#)==if delta>0 then print_ln('I had to round some ', -@.I had to round...@> - #,'s by ',(((delta+1) div 2)/@'4000000):1:7,' units.') - -@<Put the width, height, depth, and italic lists into final form@>= -case ofm_level of - -1: begin - top_width:=255; top_depth:=15; top_height:=15; top_italic:=63; - end; - 0: begin - top_width:=65535; top_depth:=255; top_height:=255; top_italic:=255; - end; - 1: begin - top_width:=65535; top_depth:=255; top_height:=255; top_italic:=255; - end; - end; -delta:=shorten(width,max_width); set_indices(width,delta); - round_message('width');@/ -delta:=shorten(height,max_height); set_indices(height,delta); - round_message('height');@/ -delta:=shorten(depth,max_depth); set_indices(depth,delta); - round_message('depth');@/ -delta:=shorten(italic,max_italic); set_indices(italic,delta); - round_message('italic correction'); - -@ @d clear_lig_kern_entry== {make an unconditional \.{STOP}} - lig_kern[nl].b0:=255; lig_kern[nl].b1:=0; - lig_kern[nl].b2:=0; lig_kern[nl].b3:=0 - -@<Make sure the ligature/kerning program ends...@>= -begin if bchar_label<xmax_label then begin {make room for it} - clear_lig_kern_entry; incr(nl); - end; {|bchar_label| will be stored later} -while min_nl>nl do begin - clear_lig_kern_entry; incr(nl); - end; -if (lig_kern[nl-1].b0 mod 256)=0 then - lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag; -end - -@ It's not trivial to check for infinite loops generated by repeated -insertion of ligature characters. But fortunately there is a nice -algorithm for such testing, copied here from the program \.{TFtoPL} -where it is explained further. - -@d simple=0 {$f(x,y)=z$} -@d left_z=1 {$f(x,y)=f(z,y)$} -@d right_z=2 {$f(x,y)=f(x,z)$} -@d both_z=3 {$f(x,y)=f(f(x,z),y)$} -@d pending=4 {$f(x,y)$ is being evaluated} - - -@ @<Glo...@>= -@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|} -@!hash:array[0..hash_size] of integer; -@!class:array[0..hash_size] of simple..pending; -@!lig_z:array[0..hash_size] of xxchar_type; -@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|} -@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries} -@!h,@!hh:0..hash_size; {indices into the hash table} -@!tt:indx; {temporary register} -@!x_lig_cycle,@!y_lig_cycle:xchar_type; {problematic ligature pair} - -@ @<Set init...@>= -hash_ptr:=0; y_lig_cycle:=xmax_char; -for k:=0 to hash_size do hash[k]:=0; - -@ @d lig_exam==lig_kern[lig_ptr].b1 -@d lig_gen==lig_kern[lig_ptr].b3 - -@<Check lig...@>= -begin lig_ptr:=char_remainder[c]; -repeat if hash_input(lig_ptr,c) then begin - if lig_kern[lig_ptr].b2<kern_flag then begin - if lig_exam<>bchar then - check_existence(lig_exam)('LIG character examined by'); -@.LIG character examined...@> - check_existence(lig_gen)('LIG character generated by'); -@.LIG character generated...@> - if lig_gen>=128 then if(c<128)or(c=bchar) then - if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true; - end - else if lig_exam<>bchar then - check_existence(lig_exam)('KRN character examined by'); -@.KRN character examined...@> - end; -if (lig_kern[lig_ptr].b0 mod 256)>=stop_flag then lig_ptr:=nl -else lig_ptr:=lig_ptr+1+lig_kern[lig_ptr].b0; -until lig_ptr>=nl; -end - -@ The |hash_input| procedure is copied from \.{TFtoPL}, but it is made -into a boolean function that returns |false| if the ligature command -was masked by a previous one. - -@p function hash_input(@!p,@!c:indx):boolean; - {enter data for character |c| and command in location |p|, unless it isn't new} -label 30; {go here for a quick exit} -var @!cc:simple..both_z; {class of data being entered} -@!zz:char_type; {function value or ligature character being entered} -@!y:char_type; {the character after the cursor} -@!key:integer; {value to be stored in |hash|} -@!t:integer; {temporary register for swapping} -begin if hash_ptr=hash_size then - begin hash_input:=false; goto 30;@+end; -@<Compute the command parameters |y|, |cc|, and |zz|@>; -key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size; -while hash[h]>0 do begin - if hash[h]<=key then begin - if hash[h]=key then begin - hash_input:=false; goto 30; {unused ligature command} - end; - t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion} - t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap} - t:=lig_z[h]; lig_z[h]:=zz; zz:=t; - end; - if h>0 then decr(h)@+else h:=hash_size; - end; -hash[h]:=key; class[h]:=cc; lig_z[h]:=zz; -incr(hash_ptr); hash_list[hash_ptr]:=h; -hash_input:=true; -30:end; - -@ @<Compute the command param...@>= -y:=lig_kern[p].b1; t:=lig_kern[p].b2; cc:=simple; -zz:=lig_kern[p].b3; -if t>=kern_flag then zz:=y -else begin - case t of - 0,6:do_nothing; {\.{LIG},\.{/LIG>}} - 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}} - 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}} - 2:cc:=right_z; {\.{/LIG}} - 3:cc:=both_z; {\.{/LIG/}} - end; {there are no other cases} - end - -@ (More good stuff from \.{TFtoPL}.) - -@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@> - {compute $f$ for arguments known to be in |hash[h]|} -function eval(@!x,@!y:indx):indx; {compute $f(x,y)$ with hashtable lookup} -var @!key:integer; {value sought in hash table} -begin key:=xmax_char*x+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size; -while hash[h]>key do - if h>0 then decr(h)@+else h:=hash_size; -if hash[h]<key then eval:=y {not in ordered hash table} -else eval:=f(h,x,y); -end; - -@ Pascal's beastly convention for |forward| declarations prevents us from -saying |function f(h,x,y:indx):indx| here. - -@p function f; -begin case class[h] of - simple: do_nothing; - left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple; - end; - right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple; - end; - both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y); - class[h]:=simple; - end; - pending: begin x_lig_cycle:=x; y_lig_cycle:=y; - lig_z[h]:=xxmax_char; class[h]:=simple; - end; {the value |xxmax_char| will break all cycles, since it's not in |hash|} - end; {there are no other cases} -f:=lig_z[h]; -end; - -@ @<Check for infinite...@>= -if hash_ptr<hash_size then for hh:=1 to hash_ptr do begin - tt:=hash_list[hh]; - if class[tt]>simple then {make sure $f$ is well defined} - tt:=f(tt,(hash[tt]-1)div xmax_char,(hash[tt]-1)mod xmax_char); - end; -if(hash_ptr=hash_size)or(y_lig_cycle<xmax_char) then begin - if hash_ptr<hash_size then begin - print('Infinite ligature loop starting with '); -@.Infinite ligature loop...@> - if x_lig_cycle=xmax_char - then print('boundary')@+else print_hex(x_lig_cycle); - print(' and '); print_hex(y_lig_cycle); print_ln('!'); - end - else print_ln('Sorry, I haven''t room for so many ligature/kern pairs!'); -@.Sorry, I haven't room...@> - print_ln('All ligatures will be cleared.'); - for c:=0 to max_char do if char_tag[c]=lig_tag then begin - char_tag[c]:=no_tag; char_remainder[c]:=0; - end; - nl:=0; bchar:=xmax_char; bchar_label:=xmax_label; - end - -@ The lig/kern program may still contain references to nonexistent characters, -if parts of that program are never used. Similarly, there may be extensible -characters that are never used, because they were overridden by -\.{NEXTLARGER}, say. This would produce an invalid \.{TFM} file; so we -must fix such errors. - -@d double_check_tail(#)==@t\1@>if char_wd[0]=0 - then char_wd[0]:=sort_in(width,0); - print('Unused ',#,' refers to nonexistent character '); - print_hex(c); print_ln('!'); - end; - end -@d double_check_lig(#)==begin c:=lig_kern[lig_ptr].#; - if char_wd[c]=0 then if c<>bchar then - begin lig_kern[lig_ptr].#:=0; double_check_tail -@d double_check_ext(#)==begin c:=exten[g].#; - if c>0 then if char_wd[c]=0 then - begin exten[g].#:=0; double_check_tail -@d double_check_rep(#)==begin c:=exten[g].#; - if char_wd[c]=0 then - begin exten[g].#:=0; double_check_tail - -@<Doublecheck...@>= -if nl>0 then for lig_ptr:=0 to nl-1 do - if (lig_kern[lig_ptr].b0 div 256)=0 then begin - if lig_kern[lig_ptr].b2<kern_flag then begin - if lig_kern[lig_ptr].b0<255 then begin - double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step'); - end; - end - else double_check_lig(b1)('KRN step'); - end; -@.Unused LIG step...@> -@.Unused KRN step...@> -if ne>0 then for g:=0 to ne-1 do begin - double_check_ext(b0)('VARCHAR TOP'); - double_check_ext(b1)('VARCHAR MID'); - double_check_ext(b2)('VARCHAR BOT'); - double_check_rep(b3)('VARCHAR REP'); -@.Unused VARCHAR...@> - end - -@* The TFM output phase. -Now that we know how to get all of the font data correctly stored in -\.{VPtoVF}'s memory, it only remains to write the answers out. - -First of all, it is convenient to have an abbreviation for output to the -\.{TFM} file: - -@d out(#)==write(tfm_file,#) - -@p procedure out_int(@!x:integer); -begin out_four(out); -end; - - -@ The general plan for producing \.{TFM} files is long but simple: - -@<Do the font metric output@>= -compute_subfile_sizes; -output_subfile_sizes; -@<Output the header block@>; -output_new_information_ofm; -output_character_info; -@<Output the dimensions themselves@>; -@<Output the ligature/kern program@>; -@<Output the extensible character recipes@>; -@<Output the parameters@> - -@ A \.{TFM} file begins with 12 numbers that tell how big its subfiles are. -We already know most of these numbers; for example, the number of distinct -widths is |memory[width]+1|, where the $+1$ accounts for the zero width that -is always supposed to be present. But we still should compute the beginning -and ending character codes (|bc| and |ec|), the number of header words (|lh|), -and the total number of words in the \.{TFM} file (|lf|). - -@<Gl...@>= -@!bc:char_type; {the smallest character code in the font} -@!ec:char_type; {the largest character code in the font} -@!lh:char_type; {the number of words in the header block} -@!lf:unsigned_integer; {the number of words in the entire \.{TFM} file} -@!not_found:boolean; {has a font character been found?} -@!temp_width:fix_word; {width being used to compute a check sum} -@!ncw,@!nco,@!npc:integer; - -@ It might turn out that no characters exist at all. But \.{VPtoVF} keeps -going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc| -will be~1. - -@<Compute the subfile sizes@>= -case ofm_level of - -1: begin - lh:=header_ptr div 4;@/ - not_found:=true; bc:=0; - while not_found do - if (char_wd[bc]>0)or(bc=255) then not_found:=false - else incr(bc); - not_found:=true; ec:=255; - while not_found do - if (char_wd[ec]>0)or(ec=0) then not_found:=false - else decr(ec); - if bc>ec then bc:=1; - incr(memory[width]); incr(memory[height]); incr(memory[depth]); - incr(memory[italic]);@/ - @<Compute the ligature/kern program offset@>; - lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+ - memory[italic]+nl+lk_offset+nk+ne+np; - end; - 0: begin - lh:=header_ptr div 4;@/ - not_found:=true; bc:=0; - while not_found do - if (char_wd[bc]>0)or(bc=max_char) then not_found:=false - else incr(bc); - not_found:=true; ec:=max_char; - while not_found do - if (char_wd[ec]>0)or(ec=0) then not_found:=false - else decr(ec); - if bc>ec then bc:=1; - incr(memory[width]); incr(memory[height]); incr(memory[depth]); - incr(memory[italic]);@/ - @<Compute the ligature/kern program offset@>; - lf:=14+lh+2*(ec-bc+1)+memory[width]+memory[height]+memory[depth]+ - memory[italic]+2*nl+lk_offset+nk+2*ne+np; - end; - 1: begin - lh:=header_ptr div 4;@/ - not_found:=true; bc:=0; - while not_found do - if (char_wd[bc]>0)or(bc=max_char) then not_found:=false - else incr(bc); - not_found:=true; ec:=max_char; - while not_found do - if (char_wd[ec]>0)or(ec=0) then not_found:=false - else decr(ec); - if bc>ec then bc:=1; - incr(memory[width]); incr(memory[height]); incr(memory[depth]); - incr(memory[italic]);@/ - @<Compute the ligature/kern program offset@>; - @<Compute the character info size@>; - lf:=29+lh+ncw+memory[width]+memory[height]+memory[depth]+ - memory[italic]+2*(nl+lk_offset)+nk+2*ne+np+ - nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp; - nco:=29+lh+nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp; - end; - end; - -@ @d out_size(#)==out((#) div 256); out((#) mod 256) - @d out_integer(#)==out((#) div @"1000000); - out(((#) mod @"1000000) div @"10000); - out(((#) mod @"10000) div @"100); - out((#) mod @"100) - -@<Output the subfile sizes@>= -case ofm_level of - -1: begin - out_size(lf); out_size(lh); out_size(bc); out_size(ec); - out_size(memory[width]); out_size(memory[height]); - out_size(memory[depth]); out_size(memory[italic]); - out_size(nl+lk_offset); out_size(nk); out_size(ne); out_size(np); - end; - 0: begin - out_integer(0); - out_integer(lf); out_integer(lh); out_integer(bc); out_integer(ec); - out_integer(memory[width]); out_integer(memory[height]); - out_integer(memory[depth]); out_integer(memory[italic]); - out_integer(nl+lk_offset); out_integer(nk); - out_integer(ne); out_integer(np); out_integer(font_dir); - end; - 1: begin - out_integer(1); - out_integer(lf); out_integer(lh); - out_integer(bc); out_integer(ec); - out_integer(memory[width]); out_integer(memory[height]); - out_integer(memory[depth]); out_integer(memory[italic]); - out_integer(nl+lk_offset); out_integer(nk); - out_integer(ne); out_integer(np); out_integer(font_dir); - out_integer(nco); out_integer(ncw); out_integer(npc); - out_integer(nki); out_integer(nwi); out_integer(nkf); out_integer(nwf); - out_integer(nkm); out_integer(nwm); out_integer(nkr); out_integer(nwr); - out_integer(nkg); out_integer(nwg); out_integer(nkp); out_integer(nwp); - end; - end; - -@ The routines that follow need a few temporary variables of different types. - -@<Gl...@>= -@!j:0..max_header_bytes; {index into |header_bytes|} -@!p:pointer; {index into |memory|} -@!q:width..italic; {runs through the list heads for dimensions} -@!par_ptr:0..max_param_words; {runs through the parameters} - -@ The header block follows the subfile sizes. The necessary information all -appears in |header_bytes|, except that the design size and the seven-bit-safe -flag must still be set. - -@<Output the header block@>= -if not check_sum_specified then @<Compute the check sum@>; -header_bytes[design_size_loc]:=design_size div @'100000000; - {this works since |design_size>0|} -header_bytes[design_size_loc+1]:=(design_size div @'200000) mod 256; -header_bytes[design_size_loc+2]:=(design_size div 256) mod 256; -header_bytes[design_size_loc+3]:=design_size mod 256; -if not seven_unsafe then header_bytes[seven_flag_loc]:=128; -for j:=0 to header_ptr-1 do out(header_bytes[j]); - -@ @<Compute the check sum@>= -begin c0:=bc; c1:=ec; c2:=bc; c3:=ec; -for c:=bc to ec do if char_wd[c]>0 then begin - temp_width:=memory[char_wd[c]]; - if design_units<>unity then - temp_width:=round((temp_width/design_units)*1048576.0); - temp_width:=temp_width + (c+4)*@'20000000; {this should be positive} - c0:=(c0+c0+temp_width) mod 255; - c1:=(c1+c1+temp_width) mod 253; - c2:=(c2+c2+temp_width) mod 251; - c3:=(c3+c3+temp_width) mod 247; - end; -header_bytes[check_sum_loc]:=c0; -header_bytes[check_sum_loc+1]:=c1; -header_bytes[check_sum_loc+2]:=c2; -header_bytes[check_sum_loc+3]:=c3; -end - -@ @<Global...@>= -@!tab:integer; - -@ -@<Compute the character info size@>= -if ofm_level=1 then begin - ncw:=0; - if nkcp>-1 then - npc:=nki+nkf+nkr+nkg+nkcp+1 - else if nkcg>-1 then - npc:=nki+nkf+nkr+nkcg+1 - else if nkcr>-1 then - npc:=nki+nkf+nkcr+1 - else if nkcf>-1 then - npc:=nki+nkcf+1 - else if nkci>-1 then - npc:=nkci+1 - else - npc:=0; - needed_space:=(12+npc*2) div 4; - extra_bytes:=(needed_space*4) - (10+npc*2); - for c:=bc to ec do begin - if char_original[c]=c then begin - cprime:=c+1; - diff:=false; - while (not diff) and (cprime<=ec) do begin - if index[char_wd[c]]<>index[char_wd[cprime]] then diff:=true; - if index[char_ht[c]]<>index[char_ht[cprime]] then diff:=true; - if index[char_dp[c]]<>index[char_dp[cprime]] then diff:=true; - if index[char_ic[c]]<>index[char_ic[cprime]] then diff:=true; - if char_remainder[c]<>char_remainder[cprime] then diff:=true; - for tab:=0 to npc-1 do begin - if char_table[c,tab]<>char_table[cprime,tab] then diff:=true; - end; - if not diff then begin - char_original[cprime]:=c; - cprime:=cprime+1; - end; - end; - if cprime>(c+1) then begin - char_repeats[c]:=cprime-c-1; - end; - ncw:=ncw+needed_space; - end; - end; - end; - -@ The next block contains packed |char_info|. - -@d out_two(#)==out((#) div 256); out((#) mod 256) - -@d out_three(#)==out((#) div 65536); out_two((#) mod 65536) - - -@<Output the character info@>= -index[0]:=0; -for c:=bc to ec do -case ofm_level of - -1: begin - out(index[char_wd[c]]); - out(index[char_ht[c]]*16+index[char_dp[c]]); - out(index[char_ic[c]]*4+char_tag[c]); - out(char_remainder[c]); - end; - 0: begin - out(index[char_wd[c]] div 256); out(index[char_wd[c]] mod 256); - out(index[char_ht[c]]); out(index[char_dp[c]]); - out(index[char_ic[c]] div 64);out((index[char_ic[c]] mod 64)*4+char_tag[c]); - out(char_remainder[c] div 256); out(char_remainder[c] mod 256); - end; - 1: begin - if c=char_original[c] then begin - out(index[char_wd[c]] div 256); out(index[char_wd[c]] mod 256); - out(index[char_ht[c]]); out(index[char_dp[c]]); - out(index[char_ic[c]]); - tab:=char_tag[c]; - if char_extended_tag[c] then begin - tab:=5; - end; - out(tab); - out(char_remainder[c] div 256); out(char_remainder[c] mod 256); - out_size(char_repeats[c]); - for tab:=0 to npc-1 do begin - out(char_table[c,tab] div 256); out(char_table[c,tab] mod 256); - end; - for tab:=1 to extra_bytes do begin - out(0); - end; - end; - end; - end; - -@ When a scaled quantity is output, we may need to divide it by |design_units|. -The following subroutine takes care of this, using floating point arithmetic -only if |design_units<>1.0|. - -@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|} -var @!n:byte; {the first byte after the sign} -@!m:0..65535; {the two least significant bytes} -begin if abs(x/design_units)>=16.0 then begin - print_ln('The relative dimension ',x/@'4000000:1:3, - ' is too large.'); -@.The relative dimension...@> - print(' (Must be less than 16*designsize'); - if design_units<>unity then print(' =',design_units/@'200000:1:3, - ' designunits'); - print_ln(')'); x:=0; - end; -if design_units<>unity then x:=round((x/design_units)*1048576.0); -if x<0 then begin - out(255); x:=x+@'100000000; - if x<=0 then x:=1; - end -else begin - out(0); - if x>=@'100000000 then x:=@'77777777; - end; -n:=x div @'200000; m:=x mod @'200000; -out(n); out(m div 256); out(m mod 256); -end; - -@ We have output the packed indices for individual characters. -The scaled widths, heights, depths, and italic corrections are next. - -@<Output the dimensions themselves@>= -for q:=width to italic do begin - out(0); out(0); out(0); out(0); {output the zero word} - p:=link[q]; {head of list} - while p>0 do begin - out_scaled(memory[p]); - p:=link[p]; - end; - end; - -@ One embarrassing problem remains: The ligature/kern program might be very -long, but the starting addresses in |char_remainder| can be at most~65535. -Therefore we need to output some indirect address information; we want to -compute |lk_offset| so that addition of |lk_offset| to all remainders makes -all but |lk_offset| distinct remainders less than~65536. - -For this we need a sorted table of all relevant remainders. - -@<Glob...@>= -@!label_table:array[xchar_type] of record - @!rr: -1..xmax_label; {sorted label values} - @!cc: char_type; {associated characters} - end; -@!label_ptr:xchar_type; {index of highest entry in |label_table|} -@!sort_ptr:xchar_type; {index into |label_table|} -@!lk_offset:xchar_type; {smallest offset value that might work} -@!t:0..xmax_label; {label value that is being redirected} -@!extra_loc_needed:boolean; {do we need a special word for |bchar|?} - -@ @<Compute the ligature/kern program offset@>= -@<Insert all labels into |label_table|@>; -if bchar<xmax_char then begin - extra_loc_needed:=true; lk_offset:=1; - end -else begin - extra_loc_needed:=false; lk_offset:=0; - end; -@<Find the minimum |lk_offset| and adjust all remainders@>; -if bchar_label<xmax_label then begin - lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 65536; - lig_kern[nl-1].b3:=(bchar_label+lk_offset)mod 65536; - end - -@ @<Insert all labels...@>= -label_ptr:=0; label_table[0].rr:=-1; {sentinel} -for c:=bc to ec do if char_tag[c]=lig_tag then begin - sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|} - while label_table[sort_ptr].rr>char_remainder[c] do begin - label_table[sort_ptr+1]:=label_table[sort_ptr]; - decr(sort_ptr); {move the hole} - end; - label_table[sort_ptr+1].cc:=c; - label_table[sort_ptr+1].rr:=char_remainder[c]; - incr(label_ptr); - end - -@ @<Find the minimum |lk_offset| and adjust all remainders@>= -begin sort_ptr:=label_ptr; {the largest unallocated label} -if ofm_level=-1 then begin - if label_table[sort_ptr].rr+lk_offset > 255 then begin - lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty} - repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset; - while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do begin - decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset; - end; - incr(lk_offset); decr(sort_ptr); - until lk_offset+label_table[sort_ptr].rr<256; - {N.B.: |lk_offset=256| satisfies this when |sort_ptr=0|} - end; - end -else begin - if label_table[sort_ptr].rr+lk_offset > 65535 then begin - lk_offset:=0; extra_loc_needed:=false; {location 0 can do double duty} - repeat char_remainder[label_table[sort_ptr].cc]:=lk_offset; - while label_table[sort_ptr-1].rr=label_table[sort_ptr].rr do begin - decr(sort_ptr); char_remainder[label_table[sort_ptr].cc]:=lk_offset; - end; - incr(lk_offset); decr(sort_ptr); - until lk_offset+label_table[sort_ptr].rr<65536; - {N.B.: |lk_offset=65536| satisfies this when |sort_ptr=0|} - end; - end; -if lk_offset>0 then - while sort_ptr>0 do begin - char_remainder[label_table[sort_ptr].cc]:= - char_remainder[label_table[sort_ptr].cc]+lk_offset; - decr(sort_ptr); - end; -end - -@ @<Output the ligature/kern program@>= -if ofm_level=-1 then begin - if extra_loc_needed then begin {|lk_offset=1|} - out(255); out(bchar); out(0); out(0); - end - else for sort_ptr:=1 to lk_offset do begin {output the redirection specs} - t:=label_table[label_ptr].rr; - if bchar<256 then begin - out(255); out(bchar); - end - else begin - out(254); out(0); - end; - out_size(t+lk_offset); - repeat decr(label_ptr); until label_table[label_ptr].rr<t; - end; - if nl>0 then for lig_ptr:=0 to nl-1 do begin - out(lig_kern[lig_ptr].b0); - out(lig_kern[lig_ptr].b1); - out(lig_kern[lig_ptr].b2); - out(lig_kern[lig_ptr].b3); - end; - if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr]) - end -else begin - if extra_loc_needed then begin {|lk_offset=1|} - out_size(255); out_size(bchar); out_size(0); out_size(0); - end - else for sort_ptr:=1 to lk_offset do begin {output the redirection specs} - t:=label_table[label_ptr].rr; - if bchar<xmax_char then begin - out_size(255); out_size(bchar); - end - else begin - out_size(254); out_size(0); - end; - out_size((t+lk_offset) div 256); - out_size((t+lk_offset) mod 256); - repeat decr(label_ptr); until label_table[label_ptr].rr<t; - end; - if nl>0 then for lig_ptr:=0 to nl-1 do begin - out_size(lig_kern[lig_ptr].b0); - out_size(lig_kern[lig_ptr].b1); - out_size(lig_kern[lig_ptr].b2); - out_size(lig_kern[lig_ptr].b3); - end; - if nk>0 then for krn_ptr:=0 to nk-1 do out_scaled(kern[krn_ptr]) - end - -@ @<Output the extensible character recipes@>= -if ofm_level=-1 then begin - if ne>0 then for c:=0 to ne-1 do begin - out(exten[c].b0); - out(exten[c].b1); - out(exten[c].b2); - out(exten[c].b3); - end; - end -else begin - if ne>0 then for c:=0 to ne-1 do begin - out_size(exten[c].b0); - out_size(exten[c].b1); - out_size(exten[c].b2); - out_size(exten[c].b3); - end; - end; - -@ For our grand finale, we wind everything up by outputting the parameters. - -@<Output the parameters@>= -for par_ptr:=1 to np do begin - if par_ptr=1 then - @<Output the slant (|param[1]|) without scaling@> - else out_scaled(param[par_ptr]); - end - -@ @<Output the slant...@>= -begin if param[1]<0 then begin - param[1]:=param[1]+@'10000000000; - out((param[1] div @'100000000)+256-64); - end -else out(param[1] div @'100000000); -out((param[1] div @'200000) mod 256); -out((param[1] div 256) mod 256); -out(param[1] mod 256); -end - -@* The VF output phase. -Output to |vf_file| is considerably simpler. - -@d id_byte=202 {current version of \.{VF} format} -@d vout(#)==write(vf_file,#) - -@<Glob...@>= -@!vcount:integer; {number of bytes written to |vf_file|} - -@ We need a routine to output integers as four bytes. Negative values -will never be less than $-2^{24}$. - -@p procedure vout_int(@!x:integer); -begin if x>=0 then vout(x div @'100000000) -else begin - vout(255); x:=x+@'100000000; - end; -vout((x div @'200000) mod 256); -vout((x div @'400) mod 256); vout(x mod 256); -end; - -@ @<Do the \.{VF} output@>= -vout(pre); vout(id_byte); vout(vtitle_length); -for k:=0 to vtitle_length-1 do vout(vf[vtitle_start+k]); -for k:=check_sum_loc to design_size_loc+3 do vout(header_bytes[k]); -vcount:=vtitle_length+11; -for cur_font:=0 to font_ptr-1 do @<Output a local font definition@>; -for c:=bc to ec do if char_wd[c]>0 then - @<Output a packet for character |c|@>; -repeat vout(post); incr(vcount); -until vcount mod 4 = 0 - -@ @<Output a local font definition@>= -begin vfout_fntdef(cur_font);@/ -vout(font_checksum[cur_font].b0); -vout(font_checksum[cur_font].b1); -vout(font_checksum[cur_font].b2); -vout(font_checksum[cur_font].b3); -vout_int(font_at[cur_font]); -vout_int(font_dsize[cur_font]); -vout(farea_length[cur_font]); -vout(fname_length[cur_font]); -for k:=0 to farea_length[cur_font]-1 do vout(vf[farea_start[cur_font]+k]); -if fname_start[cur_font]=vf_size then begin - vout("N"); vout("U"); vout("L"); vout("L"); - end -else for k:=0 to fname_length[cur_font]-1 do vout(vf[fname_start[cur_font]+k]); -vcount:=vcount+12+farea_length[cur_font]+fname_length[cur_font]; -end - -@ @<Output a packet for character |c|@>= -begin x:=memory[char_wd[c]]; -if design_units<>unity then x:=round((x/design_units)*1048576.0); -if (packet_length[c]>241)or(x<0)or(x>=@'100000000)or(c<0)or(c>255) then begin - vout(242); vout_int(packet_length[c]); vfout_char(c); vout_int(x); - vcount:=vcount+13+packet_length[c]; - end -else begin - vout(packet_length[c]); vout(c); vout(x div @'200000); - vout((x div @'400) mod 256); vout(x mod 256); - vcount:=vcount+5+packet_length[c]; - end; -if packet_start[c]=vf_size then - vfout_set(c) -else for k:=0 to packet_length[c]-1 do vout(vf[packet_start[c]+k]); -end - -@* The main program. -The routines sketched out so far need to be packaged into separate procedures, -on some systems, since some \PASCAL\ compilers place a strict limit on the -size of a routine. The packaging is done here in an attempt to avoid some -system-dependent changes. - -@p procedure param_enter; -begin @<Enter the parameter names@>; -end; -@# -procedure vpl_enter; -begin @<Enter all the \.{VPL} names@>; -end; -@# -procedure name_enter; {enter all names and their equivalents} -begin @<Enter all the \.{PL} names...@>; -vpl_enter; param_enter; -end; -@# -procedure read_lig_kern; -var @!krn_ptr:0..max_kerns; {an index into |kern|} -@!c:byte; {runs through all character codes} -begin @<Read ligature/kern list@>; -end; -@# -procedure output_new_information_ofm; -begin @<Output the new information for OFM files@>; -end; -@# -procedure compute_new_header_ofm; -begin @<Compute the new header information for OFM files@>; -end; -@# -procedure finish_extended_font; -begin @<Finish up the extended font stuff@>; -end; -@# -procedure output_subfile_sizes; -begin @<Output the subfile sizes@>; -end; -@# -procedure compute_subfile_sizes; -begin @<Compute the subfile sizes@>; -end; -@# -procedure output_character_info; -begin @<Output the character info@>; -end; -@# -@# -procedure read_font_rule_list; -begin @<Read font rule list@>; -end; -@# -procedure read_font_glue_list; -begin @<Read font glue list@>; -end; -@# -procedure read_font_penalty_list; -begin @<Read font penalty list@>; -end; -@# -procedure read_font_mvalue_list; -begin @<Read font mvalue list@>; -end; -@# -procedure read_font_fvalue_list; -begin @<Read font fvalue list@>; -end; -@# -procedure read_font_ivalue_list; -begin @<Read font ivalue list@>; -end; -@# -procedure read_repeated_character_info; -begin @<Read repeated character info@>; -end; -@# -procedure read_lig_kern_command; -begin @<Read a ligature/kern command@>; -end; -@# -procedure read_character_property; -begin @<Read a character property@>; -end; -@# -procedure read_char_info; -begin @<Read character info list@>; -end; -@# -procedure read_input; -var @!c:byte; {header or parameter index} -begin @<Read all the input@>; -end; -@# -procedure corr_and_check; -var @!c:xchar_type; {runs through all character codes} -@!hh:0..hash_size; {an index into |hash_list|} -@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|} -@!g:byte; {a character generated by the current character |c|} -begin @<Correct and check the information@> -end; -@# -procedure vf_output; -var @!c:char_type; {runs through all character codes} -@!cur_font:xfont_type; {runs through all local fonts} -@!k:integer; {loop index} -begin @<Do the \.{VF} output@>; -end; - -@ Here is where \.{VPtoVF} begins and ends. - -@p begin initialize;@/ -name_enter;@/ -read_input; print_ln('.');@/ -corr_and_check;@/ -@<Do the font metric output@>; -vf_output; -end. - -@ @<Global...@>= -@!ofm_level:integer; - -@ @<Set init...@>= -ofm_level:=0; {Suppose that it is a level 0 OFM file} - -@ @<Read OFM level code@>= -begin -ofm_level:=get_integer; -if (ofm_level<0) or (ofm_level>1) then begin - flush_error('OFMLEVEL must be 0 or 1 -- 1 assumed'); - ofm_level:=1; - end; -end - -@ @<Read font direction code@>= -begin -font_dir:=-1; -repeat get_next; -until cur_char<>" "; -case cur_char of - "T": begin get_next; - if cur_char="L" then font_dir:=0 - else if cur_char="R" then font_dir:=2; - end; - "B": begin get_next; - if cur_char="L" then font_dir:=4 - else if cur_char="R" then font_dir:=6; - end; - "R": begin get_next; - if cur_char="T" then font_dir:=5 - else if cur_char="B" then font_dir:=7; - end; - "L": begin get_next; - if cur_char="T" then font_dir:=1 - else if cur_char="B" then font_dir:=3; - end; - end; -while cur_char<>")" do get_next; -if font_dir = -1 then begin - flush_error('FONTDIR must be valid direction, -- TR assumed'); - font_dir:=0; - end; -end - -@ @<Read natural font direction code@>= -begin -font_dir:=-1; -repeat get_next; -until cur_char<>" "; -case cur_char of - "T": begin get_next; - if cur_char="L" then font_dir:=8 - else if cur_char="R" then font_dir:=10; - end; - "B": begin get_next; - if cur_char="L" then font_dir:=12 - else if cur_char="R" then font_dir:=14; - end; - "R": begin get_next; - if cur_char="T" then font_dir:=13 - else if cur_char="B" then font_dir:=15; - end; - "L": begin get_next; - if cur_char="T" then font_dir:=9 - else if cur_char="B" then font_dir:=11; - end; - end; -while cur_char<>")" do get_next; -if font_dir = -1 then begin - flush_error('NFONTDIR must be valid direction, -- TR assumed'); - font_dir:=8; - end; -end - -@ -Here are some general values for the various entries. -They can all be changed. - -@d arrays_per_kind==20 -@d entries_per_array==200 - -@ @<Constants...@>= -@!rule_arrays=arrays_per_kind; -@!rule_entries=entries_per_array; - -@ @<Types...@>= -rule_array_type=0..rule_arrays; -rule_entry_type=0..rule_entries; -rule_node= -record - rn_width: fix_word; - rn_height: fix_word; - rn_depth: fix_word; -end; - -@ @<Global...@>= -@!rules:array[rule_array_type,rule_entry_type] of rule_node; -@!npr:array[rule_array_type] of integer; -@!nkr:integer; -@!nkcr:integer; -@!nwr:integer; -@!r_array:integer; -@!r_number:integer; - -@ @<Set init...@>= -for r_array := 0 to rule_arrays do begin - npr[r_array]:=0; - @<Null out the rule@>; - end; -nkr:=-1; -nkcr:=-1; - -@ @<Read font rule list@>= -begin -if tables_read then - flush_error('All parameter tables must appear before character info'); -r_array:=get_integer; -if r_array>rule_arrays then - flush_error('This FONTRULE table index is too big for my present size') -else if r_array<0 then - flush_error('This FONTRULE index is negative') -else begin - if r_array>nkr then nkr:=r_array; - while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a rule@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; - finish_inner_property_list; - end; -end - -@ @<Read a rule@>= -begin -get_name; -if cur_code=comment_code then skip_to_end_of_item -else if cur_code<>rule_code then - flush_error('This property name doesn''t belong in a RULE list') -else begin - r_number:=get_integer; - if r_number>rule_entries then - flush_error('This RULE index is too big for my present table size') - else if r_number<0 then - flush_error('This RULE index is negative') - else begin - while npr[r_array]<r_number do begin - incr(npr[r_array]); @<Null out the rule@>; - end; - @<Read all of a rule's values@>; - finish_the_property; - end; - end; -end - -@ @<Null out the rule@>= -begin -rules[r_array,npr[r_array]].rn_width:=0; -rules[r_array,npr[r_array]].rn_depth:=0; -rules[r_array,npr[r_array]].rn_height:=0; -end - -@ @<Read all of a rule's values@>= -begin -while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a single rule value@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a single rule value@>= -begin -get_name; -case cur_code of - rule_width_code: - rules[r_array,r_number].rn_width:=get_fix; - rule_height_code: - rules[r_array,r_number].rn_height:=get_fix; - rule_depth_code: - rules[r_array,r_number].rn_depth:=get_fix; - end; -finish_the_property; -end - -@ @<Header information for rules@>= -begin -nwr:=0; -for r_array := 0 to nkr do begin - incr(npr[r_array]); - nwr := nwr + 3*npr[r_array]; - end; -incr(nkr); -end - -@ @<Output the rules@>= -begin -for r_array:= 0 to nkr-1 do - for r_number:=0 to npr[r_array]-1 do begin - out_scaled(rules[r_array,r_number].rn_width); - out_scaled(rules[r_array,r_number].rn_height); - out_scaled(rules[r_array,r_number].rn_depth); - end; -end - -@ @<Output the rule headers@>= -begin -for r_array:= 0 to nkr-1 do begin - out_integer(npr[r_array]); - end; -end - -@ @<Constants...@>= -@!glue_arrays=arrays_per_kind; -@!glue_entries=entries_per_array; - -@ -@d t_normal==0 -@d t_aleaders==1 -@d t_cleaders==2 -@d t_xleaders==3 - -@d o_unit==0 -@d o_fi==1 -@d o_fil==2 -@d o_fill==3 -@d o_filll==4 - -@d g_space==0 -@d g_rule==1 -@d g_char==2 - -@<Types...@>= -glue_array_type=0..glue_arrays; -glue_entry_type=0..glue_entries; -glue_node= -record - gn_width: fix_word; - gn_stretch: fix_word; - gn_shrink: fix_word; - gn_type: integer; - gn_arg_type: g_space..g_char; - gn_stretch_order: integer; - gn_shrink_order: integer; - gn_argument: integer; -end; - -@ @<Global...@>= -@!glues:array[glue_array_type,glue_entry_type] of glue_node; -@!npg:array[glue_array_type] of integer; -@!nkg:integer; -@!nkcg:integer; -@!nwg:integer; -@!g_array:integer; -@!g_byte:integer; -@!g_number:integer; - -@ @<Set init...@>= -for g_array := 0 to glue_arrays do -begin - npg[g_array]:=0; - @<Null out the glue@>; -end; -nkg:=-1; -nkcg:=-1; - -@ @<Read font glue list@>= -begin -if tables_read then - flush_error('All parameter tables must appear before character info'); -g_array:=get_integer; -if g_array>glue_arrays then - flush_error('This FONTGLUE table index is too big for my present size') -else if g_array<0 then - flush_error('This FONTGLUE index is negative') -else begin - if g_array>nkg then nkg:=g_array; - while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a glue@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; - finish_inner_property_list; - end; -end - -@ @<Read a glue@>= -begin -get_name; -if cur_code=comment_code then skip_to_end_of_item -else if cur_code<>glue_code then - flush_error('This property name doesn''t belong in a GLUE list') -else begin - g_number:=get_integer; - if g_number>glue_entries then - flush_error('This GLUE index is too big for my present table size') - else if g_number<0 then - flush_error('This GLUE index is negative') - else begin - while npg[g_array]<g_number do begin - incr(npg[g_array]); @<Null out the glue@>; - end; - @<Read all of a glue's values@>; - finish_the_property; - end; - end; -end - -@ @<Null out the glue@>= -begin -glues[g_array,npg[g_array]].gn_width:=0; -glues[g_array,npg[g_array]].gn_stretch:=0; -glues[g_array,npg[g_array]].gn_shrink:=0; -glues[g_array,npg[g_array]].gn_type:=0; -glues[g_array,npg[g_array]].gn_arg_type:=0; -glues[g_array,npg[g_array]].gn_stretch_order:=0; -glues[g_array,npg[g_array]].gn_shrink_order:=0; -glues[g_array,npg[g_array]].gn_argument:=0; -end - -@ @<Read all of a glue's values@>= -begin -while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a single glue value@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a single glue value@>= -begin -get_name; -case cur_code of - glue_width_code: - glues[g_array,g_number].gn_width:=get_fix; - glue_stretch_code: - glues[g_array,g_number].gn_stretch:=get_fix; - glue_shrink_code: - glues[g_array,g_number].gn_shrink:=get_fix; - glue_type_code: begin - g_byte:=get_integer; - if (g_byte<0) or (g_byte>3) then begin - g_byte:=0; - end; - glues[g_array,g_number].gn_type:=g_byte; - end; - glue_stretch_order_code: begin - g_byte:=get_integer; - if (g_byte<0) or (g_byte>4) then begin - g_byte:=0; - end; - glues[g_array,g_number].gn_stretch_order:=g_byte; - end; - glue_shrink_order_code: begin - g_byte:=get_integer; - if (g_byte<0) or (g_byte>4) then begin - g_byte:=0; - end; - glues[g_array,g_number].gn_shrink_order:=g_byte; - end; - glue_char_code: begin - glues[g_array,g_number].gn_argument:=get_integer; - glues[g_array,g_number].gn_arg_type:=g_char; - end; - glue_rule_code: begin - glues[g_array,g_number].gn_argument:=get_integer; - glues[g_array,g_number].gn_arg_type:=g_rule; - end; - end; -finish_the_property; -end - -@ @<Header information for glues@>= -begin -nwg:=0; -for g_array := 0 to nkg do begin - incr(npg[g_array]); - nwg := nwg + 4*npg[g_array]; - end; -incr(nkg); -end - -@ @<Output the glues@>= -begin -for g_array:= 0 to nkg-1 do - for g_number:=0 to npg[g_array]-1 do begin - g_byte:=glues[g_array,g_number].gn_type*16+ - glues[g_array,g_number].gn_arg_type; - out(g_byte); - g_byte:=glues[g_array,g_number].gn_stretch_order*16+ - glues[g_array,g_number].gn_shrink_order; - out(g_byte); - g_byte:=glues[g_array,g_number].gn_argument div 256; - out(g_byte); - g_byte:=glues[g_array,g_number].gn_argument mod 256; - out(g_byte); - out_scaled(glues[g_array,g_number].gn_width); - out_scaled(glues[g_array,g_number].gn_stretch); - out_scaled(glues[g_array,g_number].gn_shrink); - end; -end - -@ @<Output the glue headers@>= -begin -for g_array:= 0 to nkg-1 do begin - out_integer(npg[g_array]); - end; -end - -@ @<Constants...@>= -@!penalty_arrays=arrays_per_kind; -@!penalty_entries=entries_per_array; - -@ @<Types...@>= -penalty_array_type=0..penalty_arrays; -penalty_entry_type=0..penalty_entries; -penalty_node= -record - pn_val: integer; -end; - -@ @<Global...@>= -@!penalties:array[penalty_array_type,penalty_entry_type] of penalty_node; -@!npp:array[penalty_array_type] of integer; -@!nkp:integer; -@!nkcp:integer; -@!nwp:integer; -@!p_array:integer; -@!p_number:integer; - -@ @<Set init...@>= -for p_array := 0 to penalty_arrays do begin - npp[p_array]:=0; - @<Null out the penalty@>; - end; -nkp:=-1; -nkcp:=-1; - -@ @<Read font penalty list@>= -begin -if tables_read then - flush_error('All parameter tables must appear before character info'); -p_array:=get_integer; -if p_array>penalty_arrays then - flush_error('This FONTPENALTY table index is too big for my present size') -else if p_array<0 then - flush_error('This FONTPENALTY index is negative') -else begin - if p_array>nkp then nkp:=p_array; - while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a penalty@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; - finish_inner_property_list; - end; -end - -@ @<Read a penalty@>= -begin -get_name; -if cur_code=comment_code then skip_to_end_of_item -else if cur_code<>penalty_code then - flush_error('This property name doesn''t belong in a PENALTY list') -else begin - p_number:=get_integer; - if p_number>penalty_entries then - flush_error('This PENALTY index is too big for my present table size') - else if p_number<0 then - flush_error('This PENALTY index is negative') - else begin - while npp[p_array]<p_number do begin - incr(npp[p_array]); @<Null out the penalty@>; - end; - @<Read all of a penalty's values@>; - finish_the_property; - end; - end; -end - -@ @<Null out the penalty@>= -begin -penalties[p_array,npp[p_array]].pn_val:=0; -end - -@ @<Read all of a penalty's values@>= -begin -while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a single penalty value@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a single penalty value@>= -begin -get_name; -case cur_code of - penalty_val_code: - penalties[p_array,p_number].pn_val:=get_integer; - end; -finish_the_property; -end - -@ @<Header information for penalties@>= -begin -nwp:=0; -for p_array := 0 to nkp do begin - incr(npp[p_array]); - nwp := nwp + npp[p_array]; - end; -incr(nkp); -end - -@ @<Output the penalties@>= -begin -for p_array:= 0 to nkp-1 do - for p_number:=0 to npp[p_array]-1 do begin - out_integer(penalties[p_array,p_number].pn_val); - end; -end - -@ @<Output the penalty headers@>= -begin -for p_array:= 0 to nkp-1 do begin - out_integer(npp[p_array]); - end; -end - -@ @<Constants...@>= -@!mvalue_arrays=arrays_per_kind; -@!mvalue_entries=entries_per_array; - -@ @<Types...@>= -mvalue_array_type=0..mvalue_arrays; -mvalue_entry_type=0..mvalue_entries; -mvalue_node= -record - fn_val: fix_word; -end; - -@ @<Global...@>= -@!mvalues:array[mvalue_array_type,mvalue_entry_type] of mvalue_node; -@!npm:array[mvalue_array_type] of integer; -@!nkm:integer; -@!nkcm:integer; -@!nwm:integer; -@!m_array:integer; -@!m_number:integer; - -@ @<Set init...@>= -for m_array := 0 to mvalue_arrays do begin - npm[m_array]:=0; - @<Null out the mvalue@>; - end; -nkm:=-1; -nkcm:=-1; - -@ @<Read font mvalue list@>= -begin -if tables_read then - flush_error('All parameter tables must appear before character info'); -m_array:=get_integer; -if m_array>mvalue_arrays then - flush_error('This FONTMVALUE table index is too big for my present size') -else if m_array<0 then - flush_error('This FONTMVALUE index is negative') -else begin - if m_array>nkm then nkm:=m_array; - while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read an mvalue@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; - finish_inner_property_list; - end; -end - -@ @<Read an mvalue@>= -begin -get_name; -if cur_code=comment_code then skip_to_end_of_item -else if cur_code<>mvalue_code then - flush_error('This property name doesn''t belong in an MVALUE list') -else begin - m_number:=get_integer; - if m_number>mvalue_entries then - flush_error('This MVALUE index is too big for my present table size') - else if m_number<0 then - flush_error('This MVALUE index is negative') - else begin - while npm[m_array]<m_number do begin - incr(npm[m_array]); @<Null out the mvalue@>; - end; - @<Read all of an mvalue's values@>; - finish_the_property; - end; - end; -end - -@ @<Null out the mvalue@>= -begin -mvalues[m_array,npm[m_array]].fn_val:=0; -end - -@ @<Read all of an mvalue's values@>= -begin -while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a single mvalue value@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a single mvalue value@>= -begin -get_name; -case cur_code of - mvalue_val_code: - mvalues[m_array,m_number].fn_val:=get_fix; - end; -finish_the_property; -end - -@ @<Header information for mvalues@>= -begin -nwm:=0; -for m_array := 0 to nkm do begin - incr(npm[m_array]); - nwm := nwm + npm[m_array]; - end; -incr(nkm); -end - -@ @<Output the mvalues@>= -begin -for m_array:= 0 to nkm-1 do - for m_number:=0 to npm[m_array]-1 do begin - out_scaled(mvalues[m_array,m_number].fn_val); - end; -end - -@ @<Output the mvalue headers@>= -begin -for m_array:= 0 to nkm-1 do begin - out_integer(npm[m_array]); - end; -end - -@ @<Constants...@>= -@!fvalue_arrays=arrays_per_kind; -@!fvalue_entries=entries_per_array; - -@ @<Types...@>= -fvalue_array_type=0..fvalue_arrays; -fvalue_entry_type=0..fvalue_entries; -fvalue_node= -record - fn_val: fix_word; -end; - -@ @<Global...@>= -@!fvalues:array[fvalue_array_type,fvalue_entry_type] of fvalue_node; -@!npf:array[fvalue_array_type] of integer; -@!nkf:integer; -@!nkcf:integer; -@!nwf:integer; -@!f_array:integer; -@!f_number:integer; - -@ @<Set init...@>= -for f_array := 0 to fvalue_arrays do begin - npf[f_array]:=0; - @<Null out the fvalue@>; - end; -nkf:=-1; -nkcf:=-1; - -@ @<Read font fvalue list@>= -begin -if tables_read then - flush_error('All parameter tables must appear before character info'); -f_array:=get_integer; -if f_array>fvalue_arrays then - flush_error('This FONTFVALUE table index is too big for my present size') -else if f_array<0 then - flush_error('This FONTFVALUE index is negative') -else begin - if f_array>nkf then nkf:=f_array; - while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read an fvalue@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; - finish_inner_property_list; - end; -end - -@ @<Read an fvalue@>= -begin -get_name; -if cur_code=comment_code then skip_to_end_of_item -else if cur_code<>fvalue_code then - flush_error('This property name doesn''t belong in an FVALUE list') -else begin - f_number:=get_integer; - if f_number>fvalue_entries then - flush_error('This FVALUE index is too big for my present table size') - else if f_number<0 then - flush_error('This FVALUE index is negative') - else begin - while npf[f_array]<f_number do begin - incr(npf[f_array]); @<Null out the fvalue@>; - end; - @<Read all of an fvalue's values@>; - finish_the_property; - end; - end; -end - -@ @<Null out the fvalue@>= -begin -fvalues[f_array,npf[f_array]].fn_val:=0; -end - -@ @<Read all of an fvalue's values@>= -begin -while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a single fvalue value@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a single fvalue value@>= -begin -get_name; -case cur_code of - fvalue_val_code: - fvalues[f_array,f_number].fn_val:=get_fix; - end; -finish_the_property; -end - -@ @<Header information for fvalues@>= -begin -nwf:=0; -for f_array := 0 to nkf do begin - incr(npf[f_array]); - nwf := nwf + npf[f_array]; - end; -incr(nkf); -end - -@ @<Output the fvalues@>= -begin -for f_array:= 0 to nkf-1 do - for f_number:=0 to npf[f_array]-1 do begin - out_scaled(fvalues[f_array,f_number].fn_val); - end; -end - -@ @<Output the fvalue headers@>= -begin -for f_array:= 0 to nkf-1 do begin - out_integer(npf[f_array]); - end; -end - -@ @<Constants...@>= -@!ivalue_arrays=arrays_per_kind; -@!ivalue_entries=entries_per_array; - -@ @<Types...@>= -ivalue_array_type=0..ivalue_arrays; -ivalue_entry_type=0..ivalue_entries; -ivalue_node= -record - in_val: integer; -end; - -@ @<Global...@>= -@!ivalues:array[ivalue_array_type,ivalue_entry_type] of ivalue_node; -@!npi:array[ivalue_array_type] of integer; -@!font_i_array:boolean; -@!nki:integer; -@!nkci:integer; -@!nwi:integer; -@!i_array:integer; -@!i_number:integer; - -@ @<Set init...@>= -for i_array := 0 to ivalue_arrays do begin - npi[i_array]:=0; - @<Null out the ivalue@>; - end; -nki:=-1; -nkci:=-1; - -@ @<Read font ivalue list@>= -begin -if tables_read then - flush_error('All parameter tables must appear before character info'); -i_array:=get_integer; -if i_array>ivalue_arrays then - flush_error('This FONTIVALUE table index is too big for my present size') -else if i_array<0 then - flush_error('This FONTIVALUE index is negative') -else begin - if i_array>nki then nki:=i_array; - while level=1 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read an ivalue@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; - finish_inner_property_list; - end; -end - -@ @<Read an ivalue@>= -begin -get_name; -if cur_code=comment_code then skip_to_end_of_item -else if cur_code<>ivalue_code then - flush_error('This property name doesn''t belong in an IVALUE list') -else begin - i_number:=get_integer; - if i_number>ivalue_entries then - flush_error('This IVALUE index is too big for my present table size') - else if i_number<0 then - flush_error('This IVALUE index is negative') - else begin - while npi[i_array]<i_number do begin - incr(npi[i_array]); @<Null out the ivalue@>; - end; - @<Read all of an ivalue's values@>; - finish_the_property; - end; - end; -end - -@ @<Null out the ivalue@>= -begin -ivalues[i_array,npi[i_array]].in_val:=0; -end - -@ @<Read all of an ivalue's values@>= -begin -while level=2 do begin - while cur_char=" " do get_next; - if cur_char="(" then @<Read a single ivalue value@> - else if cur_char=")" then skip_to_end_of_item - else junk_error; - end; -finish_inner_property_list; -end - -@ @<Read a single ivalue value@>= -begin -get_name; -case cur_code of - ivalue_val_code: - ivalues[i_array,i_number].in_val:=get_integer; - end; -finish_the_property; -end - -@ @<Header information for ivalues@>= -begin -nwi:=0; -for i_array := 0 to nki do begin - incr(npi[i_array]); - nwi := nwi + npi[i_array]; - end; -incr(nki); -end - -@ @<Output the ivalues@>= -begin -for i_array:= 0 to nki-1 do - for i_number:=0 to npi[i_array]-1 do begin - out_integer(ivalues[i_array,i_number].in_val); - end; -end - -@ @<Output the ivalue headers@>= -begin -for i_array:= 0 to nki-1 do begin - out_integer(npi[i_array]); - end; -end - -@ @<Compute the new header information for OFM files@>= -begin -@<Header information for ivalues@>; -@<Header information for fvalues@>; -@<Header information for mvalues@>; -@<Header information for rules@>; -@<Header information for glues@>; -@<Header information for penalties@>; -end - -@ @<Output the new information for OFM files@>= -begin -@<Output the ivalue headers@>; -@<Output the fvalue headers@>; -@<Output the mvalue headers@>; -@<Output the rule headers@>; -@<Output the glue headers@>; -@<Output the penalty headers@>; -@<Output the ivalues@>; -@<Output the fvalues@>; -@<Output the rules@>; -@<Output the glues@>; -@<Output the penalties@>; -end - -@* System-dependent changes. -This section should be replaced, if necessary, by changes to the program -that are necessary to make \.{VPtoVF} 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 printed 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@> - -@* Index. -Pointers to error messages appear here together with the section numbers -where each ident\-i\-fier is used. |