// 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 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 in [ 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 ] 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 , // 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") ]