Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
stanford/makimp/typset.sai
There are no other files named typset.sai in the archive.
! Externals, global variables, required files;
External simp procedure GetGlyphInfo(integer font,charno;
reference integer x,y,height,width,space,pnt);
! ---------- a font information record;
External Record!Class FI(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;
Internal safa integer array
glyph[0:MAXF,0:MAXCH,0:3]; ! Glyph Information Table;
! First coordinate is font number, second character numbers, and third
indexes available information (0=pointer to glyst, 1=raster width, 2=input
unit width (e.g., rsu's), 3=space required in glyph table);
! ------------ Several arrays and variables used in glyph table management;
safa integer array glyst[0:MAXR], ! deletion queue;
chars[0:4*MAXR]; ! list of characters which are to be
downloaded;
integer nexglyrec, ! pointer to end of deletion queue;
pageptr, ! points to first component of deletion queue used
on current page;
chrpnt, ! pointer to end of chars list;
glydata, ! sum of space used by glyph data;
glypage; ! sum of space used by glyphs on current page;
! ------------ Typsetting variables;
internal integer marg, ! left margin setting;
xspace, ! space setting;
bskip, ! interline space setting;
curx, ! Output file horizontal position (pixels);
cury, ! Output file vertical position (pixels);
curf; ! current font number;
external integer tmarg, ! top margin;
lmarg; ! left margin;
require "outmac.sai" source!file;
require "service.sai" source!file;
! AddNewChar;
! A D D N E W C H A R A C T E R
!
! ***********************************************************************
! Takes font and char numbers, adds new entry to character list, updates
! space required counter.
! ***********************************************************************;
simp procedure AddNewChar(integer font, char);
begin "-- add new char --"
define new = {glyst[nexglyrec]};
define x = {chars[chrpnt+2]},
y = {chars[chrpnt+3]},
height = {chars[chrpnt+4]},
width = {chars[chrpnt+5]},
space = {chars[chrpnt+6]},
pnt = {chars[chrpnt+7]};
print6(<nl,"Starting AddNewChar: font ",FI:fname[fntinf[font]],
", character code ", char,", next glyph record ",nexglyrec>)
if nexglyrec > MAXR then if not Compact then ! deletion queue
overflow;
begin "-- fatal --"
error("Too many characters");
return
end "-- fatal --";
GetGlyphInfo(chars[chrpnt]_font,
chars[chrpnt+1]_char,
x,y,height,width,space,pnt);
! if a character was found, update character list pointer;
if glyph[font,char,3] 0 then chrpnt _ chrpnt+8;
glydata_glydata+glyph[font,char,3];
glypage_glypage+glyph[font,char,3];
glyph[font,char,0]_nexglyrec;
glyst[nexglyrec]_(font lsh 7) lor char; ! Impress glyph identifier;
nexglyrec_nexglyrec+1;
print6(<nl,"Added new character: font ",FI:fname[fntinf[font]],
", character code ", char,", space required ",glyph[font,char,3]>)
end "-- add new char --";
! FindChar;
! F I N D C H A R
!
! *******************************************************************
! Manages deletion queue and character list.
! *******************************************************************;
Internal simp procedure FindChar(integer char);
begin "-- find character --"
integer ptr;
print8(<nl,"Starting FindChar: current font ",FI:fname[fntinf[curf]],
", character code ",char,", next glyph record ",nexglyrec,
", page pointer ",pageptr>)
! If a new character, add it to character list;
if (ptr_glyph[curf,char,0]) < 0 then addnewchar(curf,char)
else if ptr < pageptr then ! first use on this page;
begin "-- update usage --"
print8(<nl,"Usage update, pointer ",ptr,", page pointer ",
pageptr,", next glyph record ",nexglyrec>)
if nexglyrec > MAXR then
if Compact then ptr_glyph[curf,char,0]
else ! deletion queue overflow;
begin "-- fatal --"
error("Too many characters");
return
end "-- fatal --";
glyst[nexglyrec]_glyst[ptr];
glyst[ptr]_-1; ! note gap in queue;
glyph[curf,char,0]_nexglyrec;
glypage_glypage+glyph[curf,char,3]; ! Glyph space needed
for this page;
nexglyrec_nexglyrec+1
end "-- update usage --"
end "-- find character --";
! CheckPos;
! C H E C K P O S I T I O N
!
! ********************************************************************
! Checks that the current position is within the page boundaries
! ********************************************************************;
simp procedure CheckPos(integer curx,cury);
begin "-- check position --"
if curx>absrightmarg then
error("printing attempted beyond physical page width. "&
"Requested x coordinate = "&cvs(curx))
else if curx<abslftmarg then
error("printing attempted beyond absolute left margin. "&
"Requested x coordinate = "&cvs(curx));
if cury>abspageheight then
error("printing attempted beyond bottom of page. "&
"Requested y coordinate = "&cvs(cury))
else if cury<abstopmarg then
error("printing attempted beyond absolute top margin. "&
"Requested y coordinate = "&cvs(cury));
end "-- check position --";
! SetPos;
! S E T P O S I T I O N
!
! *******************************************************************
! This routine adjusts the print position of the ImPrint-10 to match,
! "as well as possible", the position specified by input file. Most of
! the complexity of the procedure arises from the problem of
! discretization.
! Since the height and advance width of a glyph may vary as much as
! 1/2 pixel from what the formating program assumed, it is often necessary
! to add or delete whitespace inorder to retain proper alignment and line
! justification. The problem is where to add or delete. If the material
! under consideration is text, it is not desirable to alter the relative
! position of characters within a word, even if this means their absolute
! position is off by more than 1/2 pixel. In particular this means that
! movements associated with kerning should be exact, while spaces between
! words may be stretched or shrunk as necessary.
! To facilitate discretization with discretion, it is necessary to
! know the nature of the material being produced. For this reason the
! following procedure allows the input file handler to specify whether
! a move should be made so as to best approximate a new absolute position
! or a certain amount of "motion". This may be done for both the x and y
! coordinate.
! The parameters to this routine are:
!
! Boolean emovex; ! if TRUE, move exactly
! emovexamount. If FALSE, move so
! as to arrive at newx;
! Integer emovey, ! ditto for y;
! emovexamount,
! emoveyamount,
!
! newx, ! Expected new x coordinate;
! newy; ! Expected new y coordinate;
!
! The rest of the routine attempts to take advantage of certain
! special commands available in Impress to handle spaces, newlines, and
! one pixel moves.
! ********************************************************************;
! SetPos, page 2;
Internal simp procedure SetPos(boolean emovex, emovey;
integer emovexamount, emoveyamount,
newx, newy);
begin "-- SetPos --"
integer dx, dy;
own integer lastdx, lastdy;
print7(<nl,"SetPos, current (",curx,",",cury,
"), new (",newx+lmarg,",",newy+tmarg,"), exact moves ",
(if emovex then "TRUE" else "FALSE"),",",
(if emovey then "TRUE" else "FALSE"),
", exact move amounts (", emovexamount,",",emoveyamount,")">)
if emovey then
begin "-- unadjustable move --"
dy_emoveyamount;
cury_cury+dy
end "-- unadjustable move --"
else
begin "-- adjustable move --"
newy_newy+tmarg;
dy_newy-cury;
cury_newy
end "-- adjustable move --";
if emovex then
begin "-- unadjustable move --"
dx_emovexamount;
curx_curx+dx
end "-- unadjustable move --"
else
begin "-- adjustable move --"
newx_newx+lmarg;
dx_newx-curx;
curx_newx
end "-- adjustable move --";
CheckPos(curx,cury);
! SetPos, page 3;
if dy0 then if curx=marg then
begin "-- new line --"
if dybskip then
begin "-- new baselineskip --"
lastdy_bskip_dy; SetBaselineSkip(dy)
end "-- new baselineskip --";
SetNewLine;
return
end "-- new line --"
else if dy=bskip then
begin "-- baselineskip --"
lastdy_dy; marg_curx;
SetMargin(curx); SetNewLine;
return
end "-- baselineskip --"
else if dy=lastdy then
begin "-- new baselineskip --"
bskip_dy; SetBaselineSkip(dy);
marg_curx; SetMargin(curx);
SetNewLine;
return
end "-- new baselineskip --"
else
begin "-- verticle move --"
if not emovey then lastdy_dy; RelVertMove(dy)
end "-- verticle move --";
if dx=0 then return else
if dx=1 then begin OnePixelRight end else
if dx=-1 then begin OnePixelLeft end else
if dx=xspace then
begin "-- space --"
lastdx_dx; OneSpace
end "-- space --"
else
if dx=xspace+1 then
begin "-- space plus 1 --"
lastdx_dx; OneSpacePlus
end "-- space plus 1 --"
else
if dx = lastdx or dx = lastdx + 1 or dx = lastdx - 1 then
begin "-- new space --"
xspace _ lastdx min dx;
SetSpace(xspace);
if dx = xspace then
begin
OneSpace
end
else
begin
OneSpacePlus
end
end "-- new space --"
else
begin "-- horizontal move --";
if not emovex then lastdx_dx;
RelHorzMove(dx)
end "-- horizontal move --"
end "-- SetPos --";
! ClrGly;
! C L E A R G L Y P H S P A C E
!
! **********************************************************************
! Clears the glyph and glyst arrays and resets pointers.
! **********************************************************************;
Internal simp procedure ClrGly;
begin "-- Clear Glyph Space --"
arrclr(glyst,-1); arrclr(glyph,-1);
nexglyrec_0; glydata_0;
end "-- Clear Glyph Space --";