(*$b0*) program tyldvidvi(input,output); (* ---------------------------------------------------------- TeXtyl line-drawing interface for TeX. copyright (c) 1987 John S. Renner All rights reserved. ABSTRACT: TeXtyl reads in a DVI file, and processes 'specials' that refer to graphics capabilities that it knows about, like line, spline, ThickThinSpline, and musical beams and slurs. TeXtyl then outputs a new DVI file, with the special-macros expanded and converted to DVI-commands for character setting. DEPENDENCIES: Few assumptions about Pascal are assumed. All identifiers are unique to eight characters. There are notes to indicate system-dependencies. I assume the standard definition of "READ(fil, x)" to be equivalent to "x := fil^; GET(fil)" , and "WRITE(fil, x)" == "fil^ := x; PUT(fil)" . Arrays are passed by reference (VAR) for efficiency. See also the "sysdependent" procedure; Problem areas, or areas for expansion are marked with ### -------------------------------------------------------------*) (* Revision History: Jun. 1986 v1.0 Basic version of TeXtyl Dec. 1986 v1.1 Added adaptive subdivision for spline interpolation. Added Cardinal basis. Mar. 1987 v1.2 Added F and W flags for beginfigure to allow required and/or actual dimensions to interface with files output by the DP drawing program from Carnegie-Mellon also various fixes Apr. 1987 v1.3 Added linestyles (dotted, dashed, dotdashed) *) label 666, 30; (*=====================CONST============================*) #include "tylext.h" #include "texpaths.h" const TylVersion = 'This is TeXtyl, Version 1.30'; (* for dvi-commands *) PUT1 = 133; SET1 = 128; PUTRULE = 137; NOP = 138; PUSH = 141; POP = 142; RIGHTLEFT = 143; DOWNUP = 157; FONTDEF = 244; USEFONT = 236; OURFONTFLAG = 256; (* our special 'byte' value flag *) USESTDAREA = 0; (* flag to use the 'standard' area to find .tfm files *) (* some conversions and numbers *) SPPERPT = 65536; (* scaled points per printers point *) SPPERMM = 186468; (* scaled pts per millimetre *) RADTODEG = 57.29577952; (* degrees per radian *) DEGTORAD = 0.0174532925; (* radians per degree *) PI = 3.141592654; TWO16 = 65536; (* 2 ^ 16 *) TWO20 = 1048576; (* 2 ^ 20 *) TWO23 = 8388608; TWO24 = 16777216; TWO27 = 134217728; TWO31 = 2147483647; (* 2^31 - 1 *) BIGREAL = 1.0e30; MAXVECLENsp = 262144; (* Normal maximum length of longest * vector-font character in scaled points *) (* Music Font dependent constants *) DOTCHAR = 127; (* ascii number of char that is a dot *) QNOTEGHUS = 18.0; (* MF: Global Horizontal Units for a Quarternote *) QNOTEGVUS = 16.0; (* MF: Global Vertical units for a quarternote *) GBMGHUS = 12.0; (* MF: horizontal units for a grace beam *) GBMGVUS = 9.0; BMSTART = 0; BMEND = 69; (* indices for start/end of the beam chars *) LOBM1 = 0; (* indices for the regular beam chars that *) HIBM1 = 34; (* are 1 quarternote long, and *) LOBM1p5 = 35; (* for those that are 1.5 quarternotes long *) HIBM1p5 = 69; GBMSTART = 70; GBMEND = 105; (* indices for the grace beams *) LOGBMp5 = 70; (* indices for grace beam chars that *) HIGBMp5 = 87; (* are 0.5 grace quarternote long, and *) LOGBMp66 = 88; (* 0.66 grace quarternotes long *) HIGBMp66 = 105; LoVThick = 1; (* Bounds for Vector char thicknesses *) HiVThick = 13; SizVFontTable = 39; (* size of the Vector Font Table *) { 3*HiVThick } SizMFontTable = 18;(* size of the Music Font Table *) MAXLABELFONTS = 5; SizLFontTable = MAXLABELFONTS; (* size of the Label Font Table *) MAXCTLPTS = 63; (* max number of control points *) MAXCTLPTSp3 = 66; (* max control points + 3 *) ARRLIMIT = 100; (* limit for strings and other arrays *) MAXSPLINESEGS = 480; (* max number of spline segments *) MAXOLEN = 128; (* max length of Ostring that holds bytes of dvi cmds *) MAXTBDs = 50; (* max number of Fonts-to-be-Defined *) MAXDVISTRINGS = 600; (* max number of DVI Ostrings per page *) TFMSIZE = 8000; (* size of TFM array to hold .tfm file info *) (* Numeric names for the TeXtyl primitives *) Aline = 1; (* should be first *) Aspline = 2; Attspline = 3; Abeam = 4; Atieslur = 5; Aarc = 6; Alabel = 7; Afigure = 8; (* should be last one *) MAXFONTS = 60; (* number of TeX fonts to keep track of *) STACKSIZE = 50; (* size of stack for pushes and pops *) AREALENGTH = TYLPATHLEN; (* see also "sysdependent" proc for this value*) CR = 13; (* numbers of certain ascii characters *) LF = 10; HT = 9; FF = 12; ERRSIGNAL = '?'; ERRNOTBAD = 0; ERRBAD = 1; ERRREALBAD = 2; READACCESS = 4; WRITEACCESS = 2; NOPATH = 0; FONTPATH = 3; (*===========================TYPES=============================*) type (* ---- Bytes ---- *) Inbyt = -128 .. 127; OctByt = 0 .. 256; (* DVI commands are 0..255, but we need one more for an internal flag *) bytefile = packed file of Inbyt; (* ---- Strings ---- *) asciicode = 32 .. 126; charstring = packed array [1 .. ARRLIMIT] of char; ascstring = packed array [1 .. ARRLIMIT] of asciicode; (* rep for character strings *) strng = record len: 0 .. ARRLIMIT; str:charstring; end; (* rep for ascii strings *) astrng = record len: 0 .. ARRLIMIT; str: ascstring; end; (* byte strings *) pOstring = ^Ostring; Ostring = packed array[1 .. MAXOLEN] of OctByt; (* ---- PUBLIC types ---- *) VThickness = LoVThick .. HiVThick; VectKind = (VKCirc, VKVert, VKHort); BeamKind = (regular, grace); SplineKind = (BSPL, INTBSPL, CATROM, CARD); LineStyle = (solid, dotted, dashed, dotdash); ScaledPts = integer; MusIndex = integer; VecIndex = integer; ThickAryType = array[0 .. MAXSPLINESEGS] of VThickness; SplineSegments = array[1 .. MAXSPLINESEGS, 1 .. 2] of ScaledPts; ControlPoints = array [0 .. MAXCTLPTSp3, 1 .. 2] of ScaledPts; (* ----- Private Types ---- *) FontInfRec = record Cht, Cdp, Cwd : ScaledPts; Angle : real; end; pVectFontInfRec = ^VectFontInfRec; (* vector font info *) VectFontInfRec = record vkind : VectKind; DesSize : ScaledPts; PenSize : ScaledPts; psize : VThickness; MaxVectLen : ScaledPts; FontName : strng; Cksum : integer; Isdefined : boolean; DVIFontNum: integer; FontInfo : array [0 .. 127] of FontInfRec; end; pMusFontInfRec = ^MusFontInfRec; (* music font info *) MusFontInfRec = record DesSize : ScaledPts; Family : integer; FontName : strng; Cksum : integer; Isdefined : boolean; DVIFontNum: integer; Staffsize : integer; ghu : ScaledPts; gvu : ScaledPts; FontInfo : array [0 .. 127] of FontInfRec; end; pLabFontInfRec = ^LabFontInfRec; (* label fonts info *) LabFontInfRec = record DesSize : ScaledPts; FontName : strng; Cksum : integer; Isdefined : boolean; DVIFontNum : integer; internalnumber : integer; spacewidth : ScaledPts; end; (* list of dvi-strings *) dvistary = array[1 .. MAXDVISTRINGS] of pOstring; DVIBuftype = record TotByteLen : integer; Numstrings : integer; curstrindex : integer; Dstrings : dvistary; end; (* representation of list of fonts that have to be defined * before we output the BOP of the page we * just scanned *) ToBeDefinedRec = record which : char; indx : integer; end; stackrec = record sh, sv, sw, sx, sy, sz: integer; end; Stacktype = array [0 .. STACKSIZE] of stackrec; Oneby4Vector = array[1 .. 4] of real; Fourby4Matrix = array[1 .. 4, 1 .. 4] of real; Oneby5Vector = array[1 .. 5] of real; Primitive = Aline .. Afigure; pItem = ^Item; figptr = ^Figure; Item = packed record nextitem : pItem; BBlx, BBby, BBrx, BBty : ScaledPts; (* Bounding box *) itemthick : VThickness; itemvec : VectKind; itempatt : LineStyle; case kind : Primitive of Aline : ( lx1, ly1, lx2, ly2 : ScaledPts; ); Aspline : ( spltype : SplineKind; sclosed : boolean; dosmarks : integer; nsplknots : integer; spts : ControlPoints; ); Attspline : ( tspltype : SplineKind; tclosed : boolean; dottmarks : integer; nttknots : integer; ttpts : ControlPoints; ttarry : ThickAryType; ); Abeam : ( bx1, by1, bx2, by2 : ScaledPts; staf : integer; bkind : BeamKind; ); Atieslur : ( ntknots : integer; minth, maxth : VThickness; tspts : ControlPoints; ); Aarc : ( acentx, acenty : ScaledPts; aradius : ScaledPts; firstang, lastang : integer; narcknots : integer; arcpts : ControlPoints; ); Alabel : ( labx, laby : ScaledPts; fontstyle : integer; labeltext : strng; ); Afigure : ( figtheta : real; fsx, fsy : real; fdx, fdy : ScaledPts; preWid, preHt : ScaledPts; postWid, postHt : ScaledPts; depthnumber : integer; body : figptr; ); end; Figure = record things : pItem; end; (*==============================VARS============================*) var (* ----- Private vars *) catrommtx : Fourby4Matrix; (* basis matrix for catmul-rom splines*) bsplmtx : Fourby4Matrix; (* basis matrix for B-splines *) cardmtx : Fourby4Matrix; (* Cardinal spline matrix *) lastPoint : integer; (* num of output points *) intervals : integer; (* count of spline interval we are on *) ourxpos, (* internal x-position on page *) ourypos, (* internal y-position on page *) ourfontnum : integer; (* internal number of TeX font currently in use*) ourpushdepth : integer; (* depth of internal pushes *) origTexfont : integer; (* number of TeX font in use before tyling *) GDVIBuf : DVIBuftype; (* Global DVI buffer that contains a list of * dvi commands for this page. All dvi-cmds * parsed are put here and possibly modified * before being written to the output file *) VFontTable : array [1 .. SizVFontTable] of pVectFontInfRec; MFontTable : array [1 .. SizMFontTable] of pMusFontInfRec; LFontTable : array [1 .. SizLFontTable] of pLabFontInfRec; (* the font tables, and the number of fonts defined in each *) VFontsDefd, MFontsDefd, LFontsDefd : integer; GDVIFN : integer; (* dvi font number currently in use *) (* table of fonts yet To-Be-Defined *) TBD : array[1 .. MAXTBDs] of ToBeDefinedRec; FTBDs : integer; (* number of fonts to be defined for current page *) pageitems : pItem; (* list of primitives in current use in the current * figure on the current page *) TotBytesWritten : integer; ourq : integer; (* the 'q' for the postpost *) specstart: integer; (* the place in the DVI buffer where the * start of the special begins. * this is so that we know how far to back up * and over-write the old \special macro string * with the cmds of our 'macro-expansion' *) multifigure : integer; (* depth of definition recursion of figures *) didnewfonts : boolean; (* did we define the new fonts for this page? *) prevfont : integer; (* to keep track of prev font before the * PUSH and expansion of the special *) pgfigurenum : integer; (* figure number for this page *) currpagenum : integer; (* number of page we are on *) skiptsclamp : boolean; (* DEBUG: should we skip post-clamping ties *) dviBBlx, dviBBrx, (* Bounding box of figure in DVI space *) dviBBby, dviBBty : ScaledPts; ErrorOccurred : boolean; (* global flag in case some error happened *) thefilename, realnameoffile : charstring; (* used externally *) (* ----- End private vars *) tfmbyte : Inbyt; vaxbyt : Inbyt; tfm: array[-100 .. TFMSIZE] of OctByt; xord: array [char] of asciicode; xchr: array [0 .. 255] of char; outname: strng; (* name of output file *) tfmname : strng; (* name of a .tfm file *) dvifname : strng; (* name of the input dvi file *) logfilnam: strng; (* name of the log file *) dvifile: bytefile; tfmfile: bytefile; outputfil: bytefile; logfile : text; curfont: integer; s : 0 .. STACKSIZE; h, v, w, x, y, z: integer; stack: Stacktype; font: array [0 .. MAXFONTS] of record num: integer; name: astrng; checksum: integer; scaledsize: integer; designsize: integer; space: integer; bc: integer; ec: integer; widths: array [0 .. 127] of ScaledPts end; nf : 0 .. MAXFONTS; MINREAL : real; (* a system-dependent 'constant' *) b0, b1, b2, b3: OctByt; inwidth: array [0 .. 255] of integer; tfmchecksum: integer; conv: real; trueconv: real; numerator, denominator: integer; defaultdirectory: strng; mag, magfactor: real; maxv, maxh, maxs : integer; maxpages, totalpages : integer; resolution: real; inpostamble : boolean; newbackptr, oldbackptr : integer; p, k : integer; waste : integer; (* ==================forward declarations============================ *) { These hooks assume that the parameters are filled "correctly", and are already transformed into 4th Quadrant DVI-space } procedure TylTieSlur (var KnotArray: ControlPoints; numknots: integer; minthick, maxthick: VThickness); forward; procedure TylThickThinSpline (thetype : SplineKind; isclosed : boolean; var KnotArray: ControlPoints; var ThikThinAry: ThickAryType; numknots: integer; vec: VectKind; patt: LineStyle; domarks : integer); forward; procedure TylSpline (thetype : SplineKind; isclosed : boolean; var KnotArray: ControlPoints; numknots: integer; thick: VThickness; vec: VectKind; patt: LineStyle; domarks : integer); forward; procedure TylLine (xl, yb, xr, yt: ScaledPts; thickness: VThickness; vec: VectKind; patt: LineStyle); forward; procedure TylBeam (fromx, fromy, tox, toy: ScaledPts; staffsize : integer; kind : BeamKind); forward; procedure TylArc (radius : ScaledPts; centx, centy : ScaledPts; firstangle, secondangle : integer; thick : VThickness; vec : VectKind; patt: LineStyle); forward; procedure TylLabel (xpos, ypos : ScaledPts; fontstyle : integer; phrase : charstring; phraselen : integer); forward; (* private procedures *) procedure definebeams (var M : pMusFontInfRec); forward; procedure definevectors (var Vec: pVectFontInfRec); forward; procedure defineNewfonts; forward; procedure doTylArc (iscircle : boolean; var apts : ControlPoints; numknots : integer; thick : VThickness; vec : VectKind; patt : LineStyle); forward; procedure strcopy (src : charstring; var dest : charstring; len : integer); forward; procedure writestrng (s :strng; tologfile : boolean); forward; (* end private procs *) {------------------------------------------------------} procedure jumpout; begin goto 666; (* global label *) end; (*-------------- System Dependent stuff ----------------------*) (* the default-directory should be where the .tfm files are * to be found. the string len should reflect this name. * Check with the local site maintainer about any necessary * additions to the reset and rewrite procedures for opening * 8-bit binary files. *) procedure sysdependent; begin setpaths; defaultdirectory.str := TYLPATH; defaultdirectory.len := TYLPATHLEN; (* AREALENGTH const should be this, too *) writeln(TylVersion,' for Berkeley Unix'); resolution := 300.0; (* just a number *) MINREAL := 1.0e-20; (* so that we avoid some underflows *) end; {------------------------------------------------------------} procedure complain (severity :integer); begin writeln(logfile,'Error in fig#',pgfigurenum:0,' on page ',currpagenum:0); case severity of ERRNOTBAD : begin write (ERRSIGNAL); end; ERRBAD : begin write (ERRSIGNAL); ErrorOccurred := true; end; ERRREALBAD : begin write (ERRSIGNAL,'! '); ErrorOccurred := true; end; end; (* case *) end; function opendvifile : boolean; begin strcopy (dvifname.str, thefilename, dvifname.len); thefilename[dvifname.len + 1] := ' '; if (testaccess (READACCESS, NOPATH)) then begin reset (dvifile, realnameoffile); opendvifile := true; end else begin writestrng(dvifname, false); writeln(' : DVI file not found/readable '); opendvifile := false; end; end; function opentfmfile : boolean; begin strcopy (tfmname.str, thefilename, tfmname.len); thefilename[tfmname.len + 1] := ' '; if (testaccess (READACCESS, FONTPATH)) then begin reset(tfmfile, realnameoffile); opentfmfile := true; end else begin writestrng(tfmname, false); writeln(' : TFM file not fount/readable '); opentfmfile := false; end; end; procedure openoutputfile; begin strcopy (outname.str, thefilename, outname.len); thefilename[outname.len + 1] := ' '; if (testaccess (WRITEACCESS, NOPATH)) then rewrite (outputfil, realnameoffile) else begin writestrng(outname, false); writeln(' : Output file not writable'); jumpout; end; end; procedure openlogfile; begin strcopy (logfilnam.str, thefilename, logfilnam.len); thefilename[logfilnam.len + 1] := ' '; if (testaccess (WRITEACCESS, NOPATH)) then rewrite (logfile, realnameoffile) else begin writestrng(logfilnam, false); writeln(' : Log file not writable'); jumpout; end; end; (* &&Module Tylsupport *) {---------------------------------------------------} procedure ClearBufString (var s : pOstring); (* clear a DVI buffer string to contain no-ops*) var i : integer; begin for i := 1 to MAXOLEN do s^[i] := NOP; end; {---------------------------------------------------} function NewBufString : pOstring; var s : pOstring; begin new (s); ClearBufString (s); NewBufString := s; end; (* NOTATION:: * All procedures that put a dvi-command into the * temporary buffer are prefixed with "cmd"... * Functions that deal with reading .tfm files are prefixed * with "T" or have "tfm" in their names. * Functions that deal with reading DVI files are * prefixed with a "D". *) {--------------------------------------------} procedure cmd1byte (cmd : OctByt); begin with GDVIBuf do begin if (Numstrings > MAXDVISTRINGS) then (* buffer full *) begin complain (ERRREALBAD); writeln (logfile,'error: too many dvistrings. Totbytes = ',TotByteLen); jumpout; end; if (curstrindex > MAXOLEN) then (* current string full *) begin Numstrings := Numstrings + 1; if (Dstrings[Numstrings] <> nil) then dispose (Dstrings[Numstrings]); Dstrings[Numstrings] := NewBufString; ClearBufString(Dstrings[Numstrings]); curstrindex := 1; end; Dstrings[Numstrings]^[curstrindex] := cmd; (* insert command byte *) TotByteLen := TotByteLen + 1; curstrindex := curstrindex + 1; end; end; {---------------------------------------------------} procedure cmd2byte (cmd : integer); begin cmd1byte (cmd div 256); cmd1byte (cmd mod 256); end; {---------------------------------------------------} procedure cmd3byte (cmd : integer); begin cmd1byte (cmd div TWO16); cmd1byte ((cmd div 256) mod 256); cmd1byte (cmd mod 256); end; {---------------------------------------------------} procedure cmd4byte (cmd : integer); var tmp : integer; begin tmp := cmd; if (tmp >= 0) then begin cmd1byte (tmp div TWO24); end else begin tmp := tmp + TWO31 + 1; (* need the +1 *) cmd1byte (tmp div TWO24 + 128); end; tmp := tmp mod TWO24; cmd1byte (tmp div TWO16); tmp := tmp mod TWO16; cmd1byte (tmp div 256); cmd1byte (tmp mod 256); end; {---------------------------------------------------} (* ### may be system dependent as integers are assumed to be signed 32-bits *) procedure cmdSigned (i : integer; numbytes: integer); var tmp : integer; begin if (numbytes = 4) then cmd4byte (i) else begin (* <= 3 bytes *) tmp := i; if (numbytes = 3) then begin if (tmp < 0) then tmp := tmp + TWO24; cmd1byte (tmp div TWO16); tmp := tmp mod TWO16; cmd1byte (tmp div 256); end; if (numbytes = 2) then begin if (tmp < 0) then tmp := tmp + TWO16; cmd1byte (tmp div 256); end; if (numbytes = 1) then begin if (tmp < 0) then tmp := tmp + 256; end; cmd1byte (tmp mod 256); (* for all *) end; end; {---------------------------------------------------} function Tgetvaxbyte : OctByt; label 9999; begin tfmbyte := tfmfile^; if (tfmbyte < 0) then Tgetvaxbyte := tfmbyte + 256 else Tgetvaxbyte := tfmbyte; if (eof (tfmfile)) then begin complain (ERRREALBAD); writeln (logfile,' early EOF of tfm file! '); goto 9999; end; get (tfmfile); 9999: end; {---------------------------------------------------} procedure readtfmword; begin b0 := Tgetvaxbyte; b1 := Tgetvaxbyte; b2 := Tgetvaxbyte; b3 := Tgetvaxbyte; end; {---------------------------------------------------} function DVaxByte : OctByt; label 99; begin vaxbyt := dvifile^; if (eof (dvifile)) then begin DVaxByte := 0; goto 99; end; if (vaxbyt < 0) then DVaxByte := vaxbyt + 256 else DVaxByte := vaxbyt; get (dvifile); 99: end; {---------------------------------------------------} (* get a byte from the DVI file, but do not copy it into the DVIbuffer *) function Dgrabbyte : integer; var b: OctByt; begin if eof(dvifile) then Dgrabbyte := 0 else begin b := DVaxByte; Dgrabbyte := b; end; end; {---------------------------------------------------} function Dget1byte : integer; var b: OctByt; begin if eof(dvifile) then Dget1byte := 0 else begin b := DVaxByte; Dget1byte := b end; cmd1byte(b); end; {---------------------------------------------------} function Dsign1byte : integer; var b: OctByt; begin b := DVaxByte; if b < 128 then Dsign1byte := b else Dsign1byte := b - 256; cmd1byte(b); end; {---------------------------------------------------} function Dget2byte : integer; var a, b: OctByt; begin a := DVaxByte; b := DVaxByte; Dget2byte := a * 256 + b; cmd1byte(a); cmd1byte(b); end; {---------------------------------------------------} function Dsign2byte : integer; var a, b: OctByt; begin a := DVaxByte; b := DVaxByte; if a < 128 then Dsign2byte := a * 256 + b else Dsign2byte := (a - 256) * 256 + b; cmd1byte(a); cmd1byte(b); end; {---------------------------------------------------} function Dget3byte : integer; var a, b, c: OctByt; begin a := DVaxByte; b := DVaxByte; c := DVaxByte; Dget3byte := (a * 256 + b) * 256 + c; cmd1byte(a); cmd1byte(b); cmd1byte(c); end; {---------------------------------------------------} function Dsign3byte : integer; var a, b, c: OctByt; begin a := DVaxByte; b := DVaxByte; c := DVaxByte; if a < 128 then Dsign3byte := (a * 256 + b) * 256 + c else Dsign3byte := ((a - 256) * 256 + b) * 256 + c; cmd1byte(a); cmd1byte(b); cmd1byte(c); end; {---------------------------------------------------} function Dsign4byte : integer; var a, b, c, d: OctByt; begin a := DVaxByte; b := DVaxByte; c := DVaxByte; d := DVaxByte; if a < 128 then Dsign4byte := ((a * 256 + b) * 256 + c) * 256 + d else Dsign4byte := (((a - 256) * 256 + b) * 256 + c) * 256 + d; cmd1byte(a); cmd1byte(b); cmd1byte(c); cmd1byte(d); end; {---------------------------------------------------} (* write a byte out to the ouput file, but if we * encounter the font flag, define the new fonts, and * continue *) procedure OutputByte (b : OctByt); var x : Inbyt; n : integer; begin n := b; if (n = OURFONTFLAG) then begin (* our special macro-flag *) n := NOP; (* nullify it *) if (not didnewfonts) then begin didnewfonts := true; defineNewfonts; (* expand the defns in the outfile itself *) end; end; (* if *) if (n > 127) then begin x := n - 256; end else x := n; outputfil^ := x; put (outputfil); TotBytesWritten := TotBytesWritten + 1; (* keep count of all bytes *) end; {---------------------------------------------------} procedure Output2Byte (i : integer); begin OutputByte (i div 256); OutputByte (i mod 256); end;