Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
stanford/makimp/lstinp.sai
There are no other files named lstinp.sai in the archive.
Entry;
begin "-- ASCII file handler --"
require "genhdr.sai" source!file;
require "lstdef.sai" source!file;
require "ebgsrc.sai" source!file;
require "inmac.sai" source!file;
require "outmac.sai" source!file;
! **********************************************************************
! ASCII listing handler.
! **********************************************************************;
! External variables;
External real mag, ! User specified magnification;
wdfactor; ! Factor to be used in converting returned
character widths;
External Integer OutPtr, ! Pointer to output buffer area;
curx, ! current Imprint-10 x position;
cury, ! current Imprint-10 y position;
curf; ! current font number;
External integer firstp, ! First page of specified range;
lastp, ! Last page of specified range;
outpages, ! Number of pages printed;
spacing; ! interline spacing;
External integer InChan; ! Input channel number;
External boolean headerflag; ! True if headers desired;
External string name, ! file name;
username, ! user name;
lstfont; ! Font for listing;
External real listfontmag; ! Font magnification for listing;
External integer pageht, ! Page height (pixels);
pagewd, ! Page width (pixels);
tmarg, ! Top margin (pixels);
lmarg, ! Left margin (pixels);
lpi; ! Lines per inch;
External integer InFlSize; ! Input file size;
External safa integer array glyph[0:MAXF,0:MAXCH,0:3];
! Glyph information table, with the
following format:
glyph[f,c,0] = pointer to glyst array,
glyph[f,c,1] = advancewidth in pixels,
glyph[f,c,2] = advancewidth in input
file units,
glyph[f,c,3] = space taken up in glyph
table by this font,
all for character #c in font #f;
External Record!Class FI( ! Font information record;
string fname; ! Font's file name;
boolean openable; ! Indicates font could be opened;
integer firstchar, ! Code of first char in font;
lastchar, ! Code of last char in font;
xline, ! Suggested interline spacing;
spwid, ! Suggested interword spacing;
dirpoint, ! Pointer to start of directory;
check, ! Checksum, for comparison with Raster file
Checksum;
jfn; ! JFN for this font file;
real mag ! magnification;
);
External record!pointer (FI) safa array fntinf[0:MAXF];
! one pointer per font;
! External procedures;
External simp procedure ResetOut; ! unmap the pages of the
output file buffer;
External simp procedure
OGlyMsk(integer curpagnum); ! Transfer glyph masks from
font files to output buffer;
External simp procedure Error(string s); ! Error handling;
External simp procedure InitPage; ! Resets glyph table, etc.;
External simp procedure
SetPos(boolean exmove, eymove; integer emovexamount,
emoveyamount,newx, newy);
! Sets new x and y
coordinates, allows
exact movements or
movements to exact
locations;
External simp procedure TableSet; ! Sets up font tables;
External simp procedure Convfctr; ! Sets up wdfactor;
External simp integer procedure
BytesIn(integer InChan, bytesize); ! Returns # of bytes in file;
External simp integer procedure
FindChar(integer char); ! Sets a character in the
output file;
! DoListing;
! D O A S C I I L I S T I N G
!
! **********************************************************************
! Does ASCII files.
! **********************************************************************;
internal procedure DoListing;
begin "-- do listing --"
boolean eof; ! indicates end of file has been reached;
string datestr; ! time and date stamp for header;
integer page,v,x,y,i,j,k,l,lasty,
headwd, ! width of header line;
Incnt, ! Input Byte counter;
spcount, ! number of spaces on this line;
pgpntr, ! pointer to start of this page;
pglength, ! pageheight - topmargin;
lnlength, ! pagewidth - (rightmargin + leftmargin);
space, ! size of space;
tabsp, ! size of inter-tab-stop space;
baselineskip; ! interline spacing;
integer array brkbyte[0:1023], ! points to location on which to
break pages (note 1024 page maximum);
brkxpos[0:1023], ! x position after page break;
brkypos[0:1023]; ! y position after page break;
! integer array linebuff; ! Buffers one line for justification;
define spos(newx,newy) = {setpos(false,false,0,0,newx,newy)};
! Note that setpos adds lmarg and tmarg onto newx and newy;
simple procedure Setf(integer fnt); ! sets current font number to fnt;
begin
curf_fnt;
space_FI:mag[fntinf[fnt]]*FI:spwid[fntinf[fnt]];
baselineskip_FI:mag[fntinf[fnt]]*FI:xline[fntinf[fnt]];
if fnt=1 and lpi 0 and (240/lpi > .66*baselineskip) then
baselineskip_240/lpi;
end;
simple procedure setstr(string s);
begin integer q;
while (s neq "") do
case (q_lop(s)) of begin
['40] begin x_x+space; end;
else begin spos(x,y); setglyph(q);
x_x+glyph[curf,q,2] end end;
end;
simple procedure SetHeader(integer p); ! Adds headers to each page;
begin
integer b;
Setf(2); ! current font is header font;
Setfont(curf); ! tell it to the Imagen;
b_1.2*baselineskip;
x_abslftmarg+10-lmarg;
y_50-tmarg;
spos(x,y);
setrule(headwd,2,0);
setrule(2,b,0);
spos(x,y+b);
setrule(headwd,2,0);
spos(x+headwd,y);
setrule(2,b,0);
y_y+baselineskip;
x_x+7;
spos(x,y);
setstr(name);
x_x+30;
spos(x,y);
setstr(datestr);
x_x+30;
spos(x,y);
setstr(username);
x_abslftmarg+headwd-lmarg-200;
setstr("Page ");
setstr(cvs(p));
end;
simple procedure notestr(string s);
begin integer q;
while (s neq "") do
case (q_lop(s)) of begin
['40] begin end;
else begin FindChar(q); end end;
end;
simple procedure SetHdrGlyphs(integer p); ! sets up chars for header;
begin
Setf(2); ! header font here;
notestr("Page ");
notestr(username);
notestr(cvs(p));
notestr(datestr);
notestr(name);
end;
! Start the main program here;
Initin; ! Initializes input file page tables;
datestr_odtim(-1,0); ! time stamp for header;
headwd_absrightmarg-(abslftmarg+20); ! Width of header line;
listfontmag_mag; ! We want user-specified magnification;
wdfactor_1.0; Convfctr;
fntinf[1]_New!Record(FI); ! We will be using font #1 as listing font;
FI:fname[fntinf[1]]_lstfont; FI:mag[fntinf[1]]_listfontmag;
fntinf[2]_New!Record(FI); ! We will be using font #2 as header font;
FI:fname[fntinf[2]]_hdrfont; FI:mag[fntinf[2]]_1.0;
TableSet; x_y_0; InitPage;
curf_2;
FindChar("e");
curf_1;
FindChar("e"); ! Must do this to load the font;
Setf(1); ! set current font to listing font;
x_y_spcount_0; pglength_(pageht-tmarg); lnlength_(pagewd-lmarg);
tabsp_TABSTP*space; ! set up tab stops;
arrclr(brkxpos,0); arrclr(brkypos,0);
! Start first scan here;
GoToByte(0); brkbyte[1]_-1; i_2;
InFlsize_BytesIn(InChan,InBpB); ! must do this as wordsin is
incorrect for TOPS20 text files;
printi1(nl,"In doListing, font ",FI:fname[fntinf[1]],", magnification ",
FI:mag[fntinf[1]],", input file size ",InFlsize*InBpW," bytes");
for Incnt_0 step 1 until (InFlsize - 1) do
begin "-- first scan --"
case v_InFileByte of begin "-- case statement --"
[BS] x_x-space;
[CR] begin "-- carriage return --"
x_0;
if LookNextByte LF then y_lasty
end "-- carriage return --";
[FF] begin "-- new page --";
brkxpos[i]_x_0; brkypos[i]_y_lasty_0;
brkbyte[i]_Incnt; i_i + 1; print("[",i - 2,"]")
end "-- new page --";
[LF] begin "-- line feed --"
while x > lnlength do
begin "-- new line --"
x_x - lnlength; printi7(nl,"New line");
y_y + (baselineskip*spacing)
end "-- new line --";
lasty_y_y+(baselineskip*spacing)
end "-- line feed --";
[SP] x_x + space;
[TAB] x_x + tabsp - (x mod tabsp);
else begin "-- character --"
if glyph[1,v,0] < 0 then FindChar(v);
while x > 0 and x + glyph[1,v,2] > lnlength do
begin "-- new line --"
x_0 max(x - lnlength); printi7(nl,"New line");
y_y + (baselineskip*spacing)
end "-- new line --";
while y > pglength do
begin "-- new page --"
brkbyte[i]_Incnt-1;
print("[",i - 2,"']");
y_y - pglength; lasty_y;
brkxpos[i]_x; brkypos[i]_y;
i_i + 1
end "-- new page --";
x_x+glyph[1,v,2]
end "-- character --"
end "-- case statement --";
end "-- first scan --";
arrclr(glyph,-1); brkbyte[i]_Incnt - 1; print("[",i - 1,"]");
! Now onto the main business;
for j_((i-1) min lastp) step -1 until (1 max firstp) do
begin "-- second and third scan --"
boolean word; ! Indicates a continuous stream of
characters is being output;
Setf(1);
print("[",j); InitPage; GotoByte(brkbyte[j] + 1);
for k_(brkbyte[j] + 1) step 1 until brkbyte[j+1] do
begin "-- second scan --"
case v_InFileByte of begin "-- case statement --"
[BS] [CR] [FF]
[LF] [SP] [TAB] nothing;
else FindChar(v)
end "-- case statement --";
end "-- second scan --";
if headerflag then SetHdrGlyphs(j);
OGlyMsk(i); ! Output glyph masks;
print("."); StartPage; ! Output page mark;
if headerflag then SetHeader(j);
Setf(1); ! Let's use the listing font here;
Setfont(curf); ! Set current font;
outpages_outpages+1;
GotoByte(brkbyte[j] + 1); x_brkxpos[j]; y_lasty_brkypos[j];
spos(x,y);
for k_(brkbyte[j] + 1) step 1 until brkbyte[j+1] do
begin "-- third pass --"
case v_InFileByte of begin "-- case statement --"
[BS] begin "-- backspace --"
x_x-space; word_FALSE
end "-- backspace --";
[CR] begin "-- carriage return --"
x_0;
if LookNextByte LF then y_lasty;
word_FALSE
end "-- carriage return --";
[FF] nothing;
[LF] begin "-- line feed --"
while x > lnlength do
begin "-- new line --"
x_x - lnlength; printi7(nl,"New line");
y_y + (baselineskip*spacing)
end "-- new line --";
lasty_y_y+(baselineskip*spacing);
word_FALSE
end "-- line feed --";
[SP] begin "-- space --"
x_x + space; word_FALSE
end "-- space --";
[TAB] begin "-- character --"
x_x + tabsp - (x mod tabsp);
word_FALSE
end "-- character --";
else begin "-- character --"
while x > 0 and x + glyph[1,v,2] > lnlength do
begin "-- new line --"
x_x - lnlength; printi7(nl,"New line");
y_y + (baselineskip*spacing)
end "-- new line --";
SetPos(FALSE,FALSE,0,0,x,y);
SetGlyph(v); x_x+glyph[1,v,2];
word_TRUE
end "-- character --"
end "-- case statement --";
end "-- third pass --";
EndPage;
print(".]")
end "-- second and third scan --"
end "-- do listing --";
end "-- ASCII file handler --";