// S F T O S D (PREPRESS)
// catalog number ???
//
//Modified April 21, 1980 10:02 PM by Lyle Ramshaw, PARC:
// changed the call on EncodeFace to the new standard. Warning!
// I have NOT implemented funny faces in SF files!
//SFTOSD(update) makes an SDtemp file from several SF files.
// If update=true, adds the SF files to the current SDtemp file.
//
//Splines in the SDtemp file are guaranteed monotonic in x and y!
//
get "scan.dfs"
get "scv.dfs"
get "ix.dfs"
structure STRING:[ length byte; char↑1,255 byte ]
// outgoing procedures
external
[
SFTOSD
]
// outgoing statics
//external
// [
// ]
//static
// [
// ]
// incoming procedures
external
[
//SCAN
Scan
ScanFor
ScanUntil
ScanInit
ScanClose
ScanSet
ScanBack
ScanGiveID
ReadNumber
ReadCom
TypeForm
StrEq
StrCop
//WINDOW
WindowSetPosition
WindowGetPosition
WindowReadBlock
WindowWriteBlock
WindowRead
WindowWrite
WindowCopy
WindowClose
//SCV package
SCVInit
SCVTransformF
SCVBeginObject
SCVEndObject
SCVMoveToF
SCVDrawToF
SCVDrawCurve
SCVFlush
//CONVERT
SetSCVTransform
//UTIL
Zero; SetBlock; MoveBlock
FSGetX
FSPut
//FONTWIDTHS
EncodeFace
//PREPRESS
PrePressWindowInit
NoFile
Scream
ReadIXTempFile
WriteIXTempFile
GetPosRelative
TypeChar
//FLOAT
FLD;FST;FTR;FLDI;FNEG;FAD;FSB;FML;FDV;FCM;FSN
FLDV;FSTV;FLDDP;FSTDP;DPAD;DPSB
DPCop
]
// incoming statics
external
[
@incline
@xfp
@yfp
]
// internal statics
static
[
@boundbox //Vector for bounding box calcs.
// Points in here:
// 0:largest #
// 4:smallest #
// 8:left x
//12:bot y
//16:right x
//20:top y
@sfscale //Scale factors
@scrw //File window
@nowordsgone //for processseg
]
// File-wide structure and manifest declarations.
structure CHR: [ //Structure to describe a character
char word // read from a file -- charcter code
pos word 2 //File position of endoding.
len word //Length of encoding.
face word //Face code
family word 10 //Family name (string)
widths: @SplineWidth //Width information for this block.
]
manifest [
idFAMILY=-5
idCHARACTER=-6
idFACE=-7
idCOMMENT=-8
idMADEFROM=-9
idVERSION=-10
idWIDTH=-11
idFIDUCIAL=-12
idUSE=-13
idSPLINES=-14
idSTOP=-15
]
// Procedures
let
//READSF command processor.
SFTOSD(update,inFile,outFile;numargs na) be [
let AC=FSGetX(256*2) //Get table for char posn's
SetBlock(AC,-1,256*2) //-1 means no char there.
let WT=FSGetX(256*SplineWidthsize) //Space for CHR structures
for i=0 to 255 do //Establish "non-ex" convention
[ // by putting in unnormalized num
let p=WT+i*SplineWidthsize
DPCop(lv p>>SplineWidth.WX,table [ 0;-1 ])
]
let lens=vec 256 //Length of each encoding
let sx=vec IXLMax //To build index entry
let fn=vec 20 //Spot for family name
Zero(fn,20)
let face=-1 //No face seen yet
let bbl=vec 4*6 //Set up bounding box array
boundbox=bbl
bbl=table [ 0;3;#100000;0; //4
-1;3;#100000;0 ] //-4
MoveBlock(boundbox,bbl,8)
let sfsc=vec 4 //Scale factors array
sfscale=sfsc
FLDI(1,1); FST(1,sfscale); FST(1,sfscale+2)
SCVInit(FSGetX,FSPut,Scream) //Initialize scan converter
scrw=PrePressWindowInit(0) //Scratch File.
//If the "update" option is specified, read the current SDtemp file
// into the scratch file. Set up AC to point to those characters,
// read in the WT information (i.e., widths), and set the "lens"
// array to contain the length of the encoding of each character.
let s=inFile
test na ls 3 then
[ outFile=-2 //SDtemp
s=0
]
or [ FLD(1,xfp);FST(1,sfscale);FLD(1,yfp);FST(1,sfscale+2)
]
if update then
[
let sw=PrePressWindowInit(outFile,false) //SDtemp
ReadIXTempFile(sw,fn,sx) //Read directory
let bc=sx>>IX.bc
let ec=sx>>IX.ec
let nc=ec-bc+1
WindowReadBlock(sw,WT+bc*SplineWidthsize,nc*SplineWidthsize)
WindowReadBlock(sw,AC+bc*2,nc*2)
let l=vec 1; l!0=0; l!1=nc*2
for c=bc to ec do if AC!(c*2) ne -1 then
DPSB(AC+c*2,l) //Positions are absolute
l!0=-1; l!1=-nc*(2+SplineWidthsize)
DPAD(l,lv sx>>IX.len) //Length of CE's
WindowCopy(sw,scrw,l) //Copy the CE's.
WindowClose(sw) //Close it off.
//Now need to calculate lengths of encodings of characters read
for c=bc to ec do if AC!(c*2) ne -1 then
[
let p=nil //Find next valid char.
test c eq ec then p=l //follows last char
or for d=c+1 to ec do if AC!(d*2) ne -1
then [ p=AC+d*2; break ]
let t=vec 1
DPCop(t,p)
DPSB(t,AC+c*2) //Subtract our starting posn
lens!c=t!1 //Length!
]
] //Update
let scsf=vec SCANIlen
if na ge 3 then
[ unless ScanInit(scsf,s) then Scream("bad input file") //Set up the scanner file
ScanSet(scsf) // and point scanner at it.
]
//Main loop of SFTOSD. s is the stream for the current SF file.
// Read from it until there are no more characters (i.e. STOP is
// encountered). Then move to the next file.
[ //Do until no more files in command line.
if s eq 0 then
[ while s eq 0 do //Get new file from command.
[ let str=vec 20
let sw=vec 5
if ReadCom(str,sw) eq 0 then break //no more
test sw!0 ne 0 then
[ ReadNumber(str)
switchon sw!1 into
[ case $I: incline=FTR(1);endcase //Italics
case $X: FST(1,sfscale);endcase //X scale
case $Y: FST(1,sfscale+2);endcase //Y scale
default: Scream("Invalid switch")
]
]
or s=str //New file
] //end of "while s eq 0"
if s eq 0 then break //No more
unless ScanInit(scsf,s) then break //Set up the scanner file
ScanSet(scsf) // and point scanner at it.
] //end of "if s eq 0"
let c=Scan() //Scan next token
if c eq ID then [ ScanClose();break] //Must be STOP
//Here begins a character
if c ne LPAREN then sfscream()
let p=vec size CHR/16
DoAChar(p) //Read and encode a charater.
//Character read and returned. Fill in family and face if not
// already specified, else check for consistency. Copy widths to the
// WT table, remember the file position of the encoding, and record
// the length of the encoding.
let c=p>>CHR.char //Character code
let c2=c*2
if AC!c2 ne -1 then //Check if already defined
TypeForm("Warning: character multiply defined*N")
let f=p>>CHR.face //Check face
test face eq -1 % face eq f then face=f or
TypeForm("Warning: multiple faces*n")
f=lv p>>CHR.family //Check family
test fn>>IXN.Name eq 0 then StrCop(f,lv fn>>IXN.Name)
or unless StrEq(f,lv fn>>IXN.Name) then
TypeForm("Warning: multiple families*n")
//Now copy widths,pos,length
MoveBlock(WT+c*SplineWidthsize,lv p>>CHR.widths,
SplineWidthsize)
DPCop(AC+c2,lv p>>CHR.pos) //File starting posn
lens!c=p>>CHR.len //Length
] repeat //Main loop.
//Calculate minimum and maximum character codes in file.
let ec,bc=0,256
for i=0 to 255 do if AC!(i*2) ne -1 then
[
if i ls bc then bc=i
if i gr ec then ec=i
]
sx>>IX.ec=ec; sx>>IX.bc=bc
let nc=(ec-bc+1)
//Now write the real file.
let w=PrePressWindowInit(outFile,true)
//Write out a directory
fn>>IXN.Code=0 //Family code for us.
sx>>IX.Type=IXTypeSplines //Fill in the IX entry.
sx>>IX.fam=0
sx>>IX.face=face
sx>>IX.siz=0
sx>>IX.rotation=0
WriteIXTempFile(w,fn,sx) //Write index entries.
WindowGetPosition(w,lv sx>>IX.sa) //Start of the coding
//Write fake WT,AC
WindowWriteBlock(w,WT,nc*SplineWidthsize)
let off=vec 1
WindowGetPosition(w,off) //AC offset
WindowWriteBlock(w,AC,nc*2)
//Write spline codings.
for i=bc to ec do
[
let i2=i*2
if AC!i2 ne -1 then //Character exists
[
WindowSetPosition(scrw,AC+i2) //Place to read
GetPosRelative(w,off,AC+i2) //Where it will be
let t=vec 1; t!0=0; t!1=lens!i //Length
WindowCopy(scrw,w,t) //Copy spline
]
]
GetPosRelative(w,lv sx>>IX.sa,lv sx>>IX.len) //Get total length
let tl=vec 1; WindowGetPosition(w,tl)
//Re-write index, WT, AC.
WindowSetPosition(w,table [ 0;0 ]) //Back to index area
WriteIXTempFile(w,fn,sx) //Re-write index
WindowWriteBlock(w,WT+bc*SplineWidthsize,nc*SplineWidthsize)
WindowWriteBlock(w,AC+bc*2,nc*2)
WindowClose(w,tl) //Truncate & close
FSPut(AC); FSPut(WT) //Return core
]
and
DoAChar(chrp) be [
let seen=0 //Mask of props encountered
let SplinesCount=0 //Num of (SPLINES ) props
let character=nil
let wv=vec 4
for i=0 to 1 do //Set boundbox to starting vals.
[
let n=i*4
MoveBlock(boundbox+2*n+8,boundbox+n,4)
MoveBlock(boundbox+2*n+12,boundbox+n,4)
]
[ //property
let c=Scan()
if c eq RPAREN then break //End of character
if c ne LPAREN then sfscream()
c=Scan() //Get property name
c=idlookup(ScanGiveID())
switchon c into [
case idFAMILY:
[
c=ScanFor(ID)
let s=ScanGiveID() //Get pointer to string
StrCop(s,lv chrp>>CHR.family)
seen=seen%1
endcase;
]
case idCHARACTER: //Character code
[
ScanFor(NUMBER)
character=FTR(1)
chrp>>CHR.char=character
TypeChar(character) //Type message
seen=seen%2
endcase
]
case idFACE:
[
//Scan three things from file that are the faces.
let n=ScanGiveID()
let str=vec 1
str>>STRING.length=3
ScanFor(ID)
str>>STRING.char↑1=(n!0)Ź
ScanFor(ID)
str>>STRING.char↑2=(n!0)Ź
ScanFor(ID)
str>>STRING.char↑3=(n!0)Ź
n=EncodeFace(str)
if n eq -1 then TypeForm("Warning: unknown faces*n")
chrp>>CHR.face=n //Save it
seen=seen%4
endcase
]
case idWIDTH:
[
ScanFor(NUMBER)
FST(1,wv) //Save widths in vector WV
ScanFor(NUMBER)
FST(1,wv+2)
seen=seen%8
endcase
]
case idFIDUCIAL:
[ //Set scaling transformation
let s=vec 2
ScanFor(NUMBER)
FST(1,s)
ScanFor(NUMBER)
FLDI(3,1);FDV(3,s);FML(3,sfscale) //X scale
FLDI(4,1);FDV(4,1);FML(4,sfscale+2) //Y scale
SetSCVTransform(25400,0,incline)
seen=seen%16
endcase
]
case idCOMMENT:
case idVERSION:
case idMADEFROM:
case idUSE:
endcase //Pass up entirely
case idSPLINES:
[
test SplinesCount eq 0
ifso //First (SPLINES ...)
[
if seen ne 31 then sfscream()
SCVTransformF(wv,wv+2) //Calculate widths
FST(8,lv chrp>>CHR.widths.WX)
FST(9,lv chrp>>CHR.widths.WY)
WindowGetPosition(scrw,lv chrp>>CHR.pos) //File posn.
]
ifnot
[
WindowWrite(scrw,DSplineFontNewObject) //New SPLINES set.
]
SplinesCount=SplinesCount+1
processsplines()
endcase
]
default:
sfscream()
]
ScanUntil(RPAREN) //End of property
] repeat //property
WindowWrite(scrw,DSplineFontEndObjects) //End of encoding
let ea=vec 1
WindowGetPosition(scrw,ea)
DPSB(ea,lv chrp>>CHR.pos)
chrp>>CHR.len=ea!1 //Length...
for i=0 to 3 do test ea!1 eq 1 //Calculate bounding
then FLDI(i,0) // box and save away
or FLDV(i,boundbox+8+4*i)
FST(0,lv chrp>>CHR.widths.XL);FST(1,lv chrp>>CHR.widths.YB)
FST(2,lv chrp>>CHR.widths.XR);FST(3,lv chrp>>CHR.widths.YT)
TypeForm(0)
]
and
//Process a (SPLINES ...) property. Calls the scan-converter package
// SCVMoveToF and SCVDrawCurve to monotonize the spline
// segments that are actually read.
processsplines() be [
let v=vec 15 //Temp for passing args to SCV
let w=vec 1
SCVBeginObject(false,false,processseg,true) //Make monotonic
[ //Process a closed curve
let c=Scan()
if c eq RPAREN then break //Done with this SPLINES
if c ne LPAREN then sfscream()
let firstflg=true //Flag to put out a MOVETO
nowordsgone=true //and separate flag for MOVETO to segproc
[ //Process a <spline>
c=Scan()
if c eq RPAREN then break
if c ne LPAREN then sfscream()
ScanFor(NUMBER) //Number of knots.
let n=FTR(1)
//Scan knot list.
ScanFor(LPAREN)
if firstflg then //First <spline> in <closed curve>
[
ScanFor(LPAREN)
ScanFor(NUMBER)
FST(1,v)
ScanFor(NUMBER)
FST(1,w)
SCVMoveToF(v,w) //Call MoveTo
ScanFor(RPAREN)
firstflg=false
]
ScanUntil(RPAREN) //Bypass remaining knots.
//Bypass weights
c=Scan()
if c eq LPAREN then ScanUntil(RPAREN)
//Now for derivatives
ScanFor(LPAREN)
for i=2 to n do // n-1 derivatives to read
[
ScanFor(LPAREN)
for j=0 to 5 do
[ //Get a derivative
ScanFor(NUMBER)
if j ge 2 then
[
FLDI(2,((j ge 4)? 6,2))
FDV(1,2)
]
FST(1,v+j*2) //Store coefficient
]
SCVDrawCurve(v,v+2,v+4,v+6,v+8,v+10)
ScanFor(RPAREN)
]
ScanFor(RPAREN)
//Bypass remaining stuff
ScanUntil(RPAREN)
] repeat //process a <spline>
] repeat //process a closed curve
ScanBack(RPAREN) //So finishes OK
]
and
//Intercept splines being spit out of the SCV package.
// Guaranteed monotonic in x and y.
// 1. Update bounding box info
// 2. Reparameterize the spline, if necessary
// 3. Write onto the file the corresponding description.
processseg(lineflag) be [
//Update extremes of bounding box being kept
let extreme(a1,a2,min,max) be [
FLDV(1,min)
if FCM(1,a1) gr 0 then FLD(1,a1)
if FCM(1,a2) gr 0 then FLD(1,a2)
FSTV(1,min)
FLDV(1,max)
if FCM(1,a1) ls 0 then FLD(1,a1)
if FCM(1,a2) ls 0 then FLD(1,a2)
FSTV(1,max)
]
extreme(csac,osac,boundbox+8,boundbox+16)
extreme(crac,orac,boundbox+12,boundbox+20)
let v=vec 13
//If this is the first thing to come through in the <closed curve>,
// put a MOVETO into the file.
if nowordsgone then
[
nowordsgone=false
v!0=DSplineFontMoveTo
FST(osac,v+1)
FST(orac,v+3)
WindowWriteBlock(scrw,v,5)
]
//The spline might in fact be a straight line. If so, things can be
// made more efficient by actually putting the straight line into the
// file. This loop sets lineflag to true if spline is really a line.
if lineflag eq false then
[
lineflag=true
for i=esb to era do if FSN(i) ne 0 then
[ lineflag=false; break ]
]
//If a line, put it out as a DRAWTO
test lineflag then
[
v!0=DSplineFontDrawTo
FST(csac,v+1)
FST(crac,v+3)
WindowWriteBlock(scrw,v,5)
]
or
[
//A spline, reparameterize it so that 0 leq t leq 1.
FLD(0,tmaxac); FSB(0,tminac) //alpha=A
FLD(1,0);FML(1,0) //A*A
FLD(2,1);FML(2,0) //A*A*A
for i=0 to 1 do //s then r
[
FLDI(3,3);FML(3,esa+i);FML(3,tminac)
FAD(3,esb+i) // 3aB+b
let iptr=i*2+v+1
FLD(4,3);FAD(4,esb+i);FML(4,tminac);FAD(4,esc+i)
FML(4,0);FST(4,iptr) //new c
FML(3,1);FST(3,iptr+4) //new b
FLD(3,esa+i);FML(3,2);FST(3,iptr+8) //new a
]
v!0=DSplineFontDrawCurve
WindowWriteBlock(scrw,v,13)
]
]
and
idlookup(idname) = valof [
// Look up the name in idname, and return its value.
if StrEq(idname,"FAMILY") then resultis idFAMILY
if StrEq(idname,"FACE") then resultis idFACE
if StrEq(idname,"CHARACTER") then resultis idCHARACTER
if StrEq(idname,"WIDTH") then resultis idWIDTH
if StrEq(idname,"FIDUCIAL") then resultis idFIDUCIAL
if StrEq(idname,"COMMENT") then resultis idCOMMENT
if StrEq(idname,"VERSION") then resultis idVERSION
if StrEq(idname,"MADE-FROM") then resultis idMADEFROM
if StrEq(idname,"USE") then resultis idUSE
if StrEq(idname,"SPLINES") then resultis idSPLINES
if StrEq(idname,"STOP") then resultis idSTOP
resultis ID
]
and
sfscream() be [
Scream("Illegal SF file format")
]