// F I L E O P S (PREPRESS) // catalog number ??? // // Extract(f) Performs extract operation on file f. // MergeDelete(f,mflg) Performs merge, supercede, delete operation on file f. // Rename(f) Performs rename operation on file f. // WidthCalc(f) Perform width merge from file f. // List(f) Make a listing of a file. get "Ix.dfs" get "Streams.d" // outgoing procedures external [ Extract MergeDelete Rename WidthCalc List ] // incoming procedures external [ PrePressWindowInit //WINDOW WindowSetPosition WindowGetPosition WindowReadBlock WindowWriteBlock WindowRead WindowWrite WindowCopy WindowEnd WindowClose //UTIL FSGetX FSPut Zero; SetBlock; MoveBlock ReadIX WriteIX CompareIX PrintIX ReadIXTempFile WriteIXTempFile TypeChar CheckParams Scream IllFormat IllCommand //FONTWIDTH DecodeFace //SCAN StrEq StrCop TypeForm //OS OpenFile Closes //FLOAT FLD;FST;FTR;FLDI;FNEG;FAD;FSB;FML;FDV;FCM;FSN FLDV;FSTV;FLDDP;FSTDP;DPAD;DPSB DPCop ] // incoming statics external [ fam face siz rotation resolutionx resolutiony params outstream ] // internal statics //static // [ // ] // File-wide structure and manifest declarations. structure IXD : [ next word //List of IX entries file word //Which file it is in OldCode0 word //For family name conversion OldCode1 word // " IX word //...following is IX entry... ] // Procedures let //Extract a font from a file f (CD or SD) Extract(f) be [ if CheckParams(gotname) eq false then IllCommand() let proto=vec IXLMax FillIX(proto) //Fill in from parameters read let famseen=false //No code seen yet let fn=vec IXLName let d=vec IXLMax let w=PrePressWindowInit(f,false) [ ReadIX(w,d) //Get an entry switchon d>>IXH.Type into [ case IXTypeEnd: TypeForm("No such font in the file*N") return case IXTypeName: [ if StrEq(fam,lv d>>IXN.Name) then [ famseen=true proto>>IX.fam=d>>IXN.Code MoveBlock(fn,d,IXLName) ] ] endcase default: if famseen & CompareIX(d,proto) then break ] ] repeat let ow=PrePressWindowInit(-f,true) WindowSetPosition(w,lv d>>IX.sa) //Go get it. WriteIXTempFile(ow,fn,d) WindowCopy(w,ow,lv d>>IX.len) WindowClose(w) WindowClose(ow,-1) ] and //MergeDelete -- for the MERGE, SUPERCEDE or DELETE commands //f = 1,2,3 merge or delete segments of SD,CD,WD //mergeflag= : // 0 Delete segment mentioned in command line. // 1 Standard merge (any stuff in file -f merged into file f) // 2 Supercede (same as merge, but spline widths in f supercede fixed // versions in -f) MergeDelete(f,mergeflag) be [ let w=PrePressWindowInit(f) //Big file (file=1) let wx=nil test mergeflag then [ //Look for the file to merge from wx=PrePressWindowInit(-f,false) //Little file (file=0) ] or unless CheckParams(gotname) then IllCommand() let d=vec IXLMax FillIX(d) //Get parameters let ws=PrePressWindowInit(0) //Scratch file let foundit=false //Did we find what the user wants (delete)? let famcode=0 //Max family name code seen let IXDList=0 //List of IX's to process let e=vec IXLMax let ffile=(mergeflag? 0,1) for file=ffile to 1 do [ let wi=(file eq 0)? wx,w [ if WindowEnd(wi) then break //If new file is empty,... ReadIX(wi,e) //Read an entry switchon e>>IXH.Type into [ case IXTypeEnd: break //Done case IXTypeName: [ let p=IXDList while p do [ let pt=lv p>>IXD.IX if pt>>IX.Type eq IXTypeName & StrEq(lv e>>IXN.Name,lv pt>>IXN.Name) then break p=p>>IXD.next ] if p eq 0 then [ p=FSGetX(size IXD/16+IXLName) let pt=lv p>>IXD.IX p>>IXD.next=IXDList //Link it in IXDList=p MoveBlock(pt,e,IXLName) p>>IXD.OldCode0=-1 p>>IXD.OldCode1=-1 //So will not compare famcode=famcode+1 pt>>IXN.Code=famcode //New code if StrEq(fam,lv e>>IXN.Name) then d>>IX.fam=famcode ] let thiscode=e>>IXN.Code //Old fam code test file eq 0 ifso p>>IXD.OldCode0=thiscode ifnot p>>IXD.OldCode1=thiscode ] endcase default: [ let copyit=true //Look for family & install new family code. let p=IXDList while p do [ let pt=lv p>>IXD.IX if pt>>IX.Type eq IXTypeName & e>>IX.fam eq ((file eq 0)? p>>IXD.OldCode0,p>>IXD.OldCode1) then [ e>>IX.fam=pt>>IXN.Code; break ] p=p>>IXD.next ] if mergeflag eq 0 & file eq 1 & CompareIX(e,d) then [ copyit=false; foundit=true ] //Look through existing ones to see if this should be omitted let p=IXDList while p do [ let pt=lv p>>IXD.IX if pt>>IX.Type eq e>>IX.Type & pt>>IX.famface eq e>>IX.famface then [ if CompareIX(e,pt) % (mergeflag eq 2 & pt>>IX.Type eq IXTypeWidths & pt>>IX.siz eq 0) then [ copyit=false break ] ] p=p>>IXD.next ] //Put on list to do! if copyit then [ p=FSGetX(size IXD/16+IXLMax) p>>IXD.next=IXDList p>>IXD.file=file IXDList=p MoveBlock(lv p>>IXD.IX,e,IXLMax) ] ] endcase ] ] repeat ] //For file WriteNewHeaders(ws,IXDList) //Go write them. //Now copy from original files to scratch. let p=IXDList while p do [ let pt=lv p>>IXD.IX if pt>>IX.Type ne IXTypeName then [ let ifile=((p>>IXD.file eq 0)? wx,w) WindowSetPosition(ifile,lv pt>>IX.sa) WindowGetPosition(ws,lv pt>>IX.sa) WindowCopy(ifile,ws,lv pt>>IX.len) ] p=p>>IXD.next ] //Remember total length let tl=vec 1; WindowGetPosition(ws,tl) //Now re-write headers WriteNewHeaders(ws,IXDList) //Now copy scratch back to original let zero=table [ 0;0 ] WindowSetPosition(w,zero) WindowSetPosition(ws,zero) WindowCopy(ws,w,tl) WindowClose(w,-1) WindowClose(ws) if mergeflag eq 0 & foundit eq false then TypeForm("Could not find specified section to delete.*n") ] and WriteNewHeaders(w,list) be [ WindowSetPosition(w,table [ 0;0 ]) //Write names first let p=list while p do [ let pt=lv p>>IXD.IX if pt>>IX.Type eq IXTypeName then WriteIX(w,-1,pt) p=p>>IXD.next ] //Write IX entries p=list while p do [ let pt=lv p>>IXD.IX if pt>>IX.Type ne IXTypeName then WriteIX(w,-1,pt) p=p>>IXD.next ] WriteIX(w,IXTypeEnd) //Write the end code ] and //Rename -- install new features in a "temp" file. Rename(f) be [ let wf=PrePressWindowInit(-f,true) //Get the file, RW let fn=vec IXLName //Place for name let ix=vec IXLMax //and thing. ReadIXTempFile(wf,fn,ix) if (params&gotname) ne 0 then [ Zero(fn,IXLName) StrCop(fam,lv fn>>IXN.Name) ] if (params&gotface) ne 0 then ix>>IX.face=face if (params&gotsize) ne 0 then ix>>IX.siz=siz if (params&gotrotation) ne 0 then ix>>IX.rotation=rotation if (params&gotresolution) ne 0 then [ ix>>IX.resolutionx=resolutionx ix>>IX.resolutiony=resolutiony ] WindowSetPosition(wf,table [ 0;0 ]) WriteIXTempFile(wf,fn,ix) WindowClose(wf,0) ] and //LIST command processor. File f is listed. List(f, fullList) be [ let strp=nil let sw=PrePressWindowInit(f,false,lv strp) let oa=vec 1; oa!0=0; oa!1=0 outstream=OpenFile("Prepress.Lst", ksTypeWriteOnly, 1) //redirect output TypeForm("File: ",strp,0) [ WindowSetPosition(sw,oa) let sx=vec IXLMax ReadIX(sw,sx) WindowGetPosition(sw,oa) //So we may get back. let bc=sx>>IX.bc let ec=sx>>IX.ec let nc=ec-bc+1 switchon sx>>IXH.Type into [ case IXTypeEnd: break case IXTypeName: TypeForm("Name: ",lv sx>>IXN.Name,". Code: ",10,sx>>IXN.Code,0) endcase case IXTypeSplines: [ TypeForm("Splines: ") PrintIX(sx) if fullList then [ WindowSetPosition(sw,lv sx>>IX.sa) for c=bc to ec do [ let p=vec SplineWidthsize WindowReadBlock(sw,p,SplineWidthsize) let pw=lv p>>SplineWidth.WX unless pw!0 eq 0 & pw!1 eq -1 then [ //Char exists. TypeChar(c) let q=pw for i=0 to 5 do [ TypeForm(2,q,$*s); q=q+2 ] TypeForm(0) if (params&gotsize) ne 0 then [ FLDI(1, siz); FLDI(2, resolutionx); FLDI(3, 25400) FML(1,2); FDV(1,3) TypeForm(" ") let q=pw for i=0 to 5 do [ FLD(2, q); FML(2, 1) TypeForm(2,2,$*s); q=q+2 ] TypeForm(0) ] ] ] ] ] endcase case IXTypeChars: [ TypeForm("Characters: ") PrintIX(sx) if fullList then [ WindowSetPosition(sw,lv sx>>IX.sa) for c=bc to ec do [ let p=vec CharWidthsize WindowReadBlock(sw,p,CharWidthsize) unless p>>CharWidth.H eq HNonExCode then [ //Char exists TypeChar(c) TypeForm(3,lv p>>CharWidth.WX,#40,3,lv p>>CharWidth.WY,$*s) TypeForm(10,p>>CharWidth.XL,$*s,10,p>>CharWidth.YB,$*s) TypeForm(10,p>>CharWidth.W,$*s,10,p>>CharWidth.H,0) ] ] ] ] endcase case IXTypeWidths: [ TypeForm("Widths: ") PrintIX(sx) if fullList then [ WindowSetPosition(sw,lv sx>>IX.sa) let s=vec size WTB/16 WindowReadBlock(sw,s,(size WTB/16)) TypeForm(" Box: ") for i=0 to 3 do TypeForm(10,s!i,#40) for what=0 to 1 do [ TypeForm((what? "*NY: ","*NX: ")) test ((what)? s>>WTB.YWidthFixed, s>>WTB.XWidthFixed) then TypeForm(10,WindowRead(sw),0) or [ for c=bc to ec do [ if c gr #37 then TypeForm(c) TypeForm("(#",8,c,") ") let wid=WindowRead(sw) test wid eq #100000 ifso TypeForm("xxx; ") ifnot TypeForm(10,wid,"; ") if (c&3) eq 3 then TypeForm(0) ] TypeForm(0) ] ] ] ] endcase ] //Switchon TypeForm(0,0,0) ] repeat Closes(outstream) outstream=0 //No more redirection WindowClose(sw) ] and //WIDTH command processor. Build a file WDtemp that contains width // information. Width information is extracted from file f. WidthCalc(f) be [ let w=PrePressWindowInit(-f,false) let ww=PrePressWindowInit(-3,true) let fn=vec IXLName let e=vec IXLMax ReadIXTempFile(w,fn,e) WindowSetPosition(w,lv e>>IX.sa) let t=e>>IXH.Type let bc=e>>IX.bc let ec=e>>IX.ec let nc=ec-bc+1 let fwt=vec size WTB/16 //For font width block. MoveBlock(fwt,table [ 16000;16000;-16000;-16000 ],4) let wx=vec 256*3; SetBlock(wx,#100000,256*3) //All non-existent let wy=wx+256 let absent=wy+256 test t eq IXTypeChars ifso [ FLDI(1,25400);FLDI(2,e>>IX.resolutionx);FDV(1,2) FLDI(2,25400);FLDI(3,e>>IX.resolutiony);FDV(2,3) for c=bc to ec do [ let p=vec CharWidthsize WindowReadBlock(w,p,CharWidthsize) unless p>>CharWidth.H eq HNonExCode then [ absent!c=false let c2=c*2 FLDDP(3,lv p>>CharWidth.WX);FML(3,1); wx!c=FTRound(3) FLDDP(3,lv p>>CharWidth.WY);FML(3,2); wy!c=FTRound(3) FLDI(3,p>>CharWidth.XL);FLDI(4,p>>CharWidth.YB) FLDI(5,p>>CharWidth.W);FLDI(6,p>>CharWidth.H) FontMinMax(1,2,fwt) ] ] ] ifnot [ FLDI(1,1000) for c=bc to ec do [ let p=vec SplineWidthsize WindowReadBlock(w,p,SplineWidthsize) let pw=lv p>>SplineWidth.WX unless pw!0 eq 0 & pw!1 eq -1 then [ absent!c=false FLD(2,lv p>>SplineWidth.WX);FML(2,1); wx!c=FTRound(2) FLD(2,lv p>>SplineWidth.WY);FML(2,1); wy!c=FTRound(2) FLD(3,lv p>>SplineWidth.XL); FLD(4,lv p>>SplineWidth.YB) FLD(5,lv p>>SplineWidth.XR); FLD(6,lv p>>SplineWidth.YT) FSB(5,3); FSB(6,4) FontMinMax(1,1,fwt) ] ] ] WindowClose(w) //Now decide if either x or y widths are the same let xwv,ywv=wx!bc,wy!bc let xsame,ysame=true,true for c=bc to ec do unless absent!c then [ if wx!c ne xwv then xsame=false if wy!c ne ywv then ysame=false ] fwt>>WTB.XWidthFixed=xsame fwt>>WTB.YWidthFixed=ysame //Now write the file e>>IXH.Type=IXTypeWidths WriteIXTempFile(ww,fn,e, (size WTB/16)+((xsame)? 1,nc)+((ysame)? 1,nc)) WindowWriteBlock(ww,fwt,(size WTB/16)) test xsame then WindowWrite(ww,xwv) or WindowWriteBlock(ww,wx+bc,nc) test ysame then WindowWrite(ww,ywv) or WindowWriteBlock(ww,wy+bc,nc) WindowClose(ww,-1) ] and FontMinMax(sx,sy,minmax) be [ for i=0 to 3 do [ let ac=3+i FML(ac,(((i&1) eq 0)? sx,sy)) let v=FTR(ac) test i le 1 then [ if v ls minmax!i then minmax!i=v ] or [ if v gr minmax!i then minmax!i=v ] ] ] and FillIX(s) be [ s>>IX.face=face s>>IX.siz=siz s>>IX.rotation=rotation s>>IX.resolutionx=resolutionx s>>IX.resolutiony=resolutiony ] and FTRound(ac) = valof [ FLDDP(31, table [ 0; #100000 ] ) //.5 FAD(31, ac) resultis FTR(31) ]