// bcpl/f PressEdit.bcpl -- merge, page edit press files // Copyright Xerox Corporation 1979, 1980, 1981, 1982 // Last modified by Bob Sproull on October 9, 1982 11:24 AM // Last modified by Lyle Ramshaw on May 29, 1982 2:29 PM // change maxillus and maxFamilies // Last modified by Lyle Ramshaw on May 29, 1982 2:29 PM // Last modified by Lyle Ramshaw on January 14, 1982 5:27 PM // Last modified by RML on August 20, 1980 6:15 PM // renamed 1.90 get "presseditdefs.bcpl" get "streams.d" // outgoing procedures external [ ReadPressPageDir ] // outgoing statics external [ Debug DocDirList docMergePtrs DLByteCount efCount efScratch // dump of external files EntVec EntByteCount ExtraFonts FamilyDir FileNames FontSets FontVec FontVecPtr illusMergePtrs InputStream InputByteStream MaxSet Merge mergeList mergePtr NFontEntries NPages NFamilies NFiles nIllus NRects OutPartDir OutDocDir OutputFileName PageList PageDir PageDirFile pageNoStart pageNoX pageNoY pageNoOmit PrivateStamp RectangleVec SetMaps SetMapPtr SetMapTable TempSets TLvec XFonts ] static [ DocDirList // list of doc directories efCount efScratch // dump of external files FamilyDir // where family names are stored FileNames // vector of pointers to file names FontSets // 64x16 table of ptrs to FONT entries PageList // list of pages PageDir // current page dir SetMapTable // see below, ReadPressFontDir PageDirFile // which file in PageDir NPages NFiles // no of press/ears files MaxSet // max no of font sets in FontSets OutPartDir // output file part dir OutDocDir // output file document dir OutputFileName // name of output file TempSets // used for assembling all font sets in 1 file FontVec // one FONT entry for each unique font FontVecPtr NFontEntries // no of entries in FontVec InputStream InputByteStream TLvec // Page TL stored here EntVec // where entities stored EntByteCount DLByteCount RectangleVec // rectangles for underscoring NRects PrivateStamp // $T or $B if stamp, $P if page number, else 0 Merge // $M if arrow merge, $A if arrowless merge, else 0 mergeList // list of files to merge on page nIllus // count of illustrations in mergeList mergePtr // where merge entry stored docMergePtrs // list of pointers in document illusMergePtrs // list of pointers for illustrations pageNoStart = 2 // where to start numbering pageNoX = 17700 // x coord of text pageNoY = 208*127 pageNoOmit = 1 // how many initial pages to omit Debug // to cause printout ] // incoming procedures external [ AddExtraFont AddExtraFonts AppendChar AppendFace BlankSet CheckFontEntry CheckSwitches Closes // ConvertPageDir CopyString CompareSets DecodeFontName DeleteFile EqStr EqChar Error FileError FileLength FindFamily FixedLeft FontFlag FreeFixed Gets GetFileLength // GetWidths GetFixed InitializeFonts IsDigit IsNumber IsPressFile LookupFamily MakeFontEntry MatchFontSets max MergeIllusFiles min MoveBlock nth OpenFile // PutEarsDocDir PutPressDocDir PageNoFlag PositionPage PositionPtr PrintFontSets Puts radixconvert ReadBlock // ReadEarsFonts ReadExternalFileDir ReadFontNames ReadParam ReadPressFontDir ScanFontSets SetInFile SetBlock SetPageNo SetupReadParam utilinit WFACE WritePresseditPrivate WriteFontSetCount WriteEndMessage WritePressPages WriteExternalFileDir WriteFontDir WritePartDir WriteDocDir WriteBlock Wns Ws Wl Zero ] // incoming statics external [ dsp ] // internal statics static [ ExtraFonts // extra fonts required SetMaps // up to 64 entries per file NFamilies // no of families in FamilyDir XFonts // no of extra fonts SetMapPtr NeedScratchFile ] // structures // manifests let Main() be [ utilinit() // for pressio Debug=false Wl("*NPress file edit program, Version 3.3 of October 9, 1982") let v1=vec MaxFamilies*FamilyLen-1; FamilyDir=v1 let v2=vec MaxPages-1; PageList=v2 let v3=vec MaxExtraFonts-1; ExtraFonts=v3 let v4=vec MaxFiles-1; FileNames=v4 let v5=vec MaxPageDir-1; PageDir=v5 let v6=vec MaxFiles*DDlen-1; DocDirList=v6 Zero(DocDirList, MaxFiles*DDlen-1) let v7=vec MaxFiles-1; SetMapTable=v7 let v8=vec SetMapsSize-1; SetMaps=v8 let v9=vec MaxPageDir-1; OutPartDir=v9 let v10=vec FONTlen*MaxFonts-1; FontVec=v10 Zero(FontVec, FONTlen*MaxFonts) let v11=vec 1023; FontSets=v11 let v12=vec 1023; TempSets=v12 let v13=vec 255; SetBlock(v13, -1, 256); OutDocDir=v13 let v16=vec 512*TLlen; TLvec=v16 let v17=vec MaxEntBytes/2-1; EntVec=v17 let v18=vec MaxRects*RECTlen-1; RectangleVec=v18 let v19=vec 30; OutputFileName=v19 let v20=vec maxIllus*MERGElen-1; mergeList=v20 let v21=vec 127; docMergePtrs=v21 let v22=vec maxIllus-1; illusMergePtrs=v22 PageDirFile=-1 // to force read NeedScratchFile=false let os=ReadArgumentList(FileNames,PageList,ExtraFonts) ReadFontNames(FamilyDir) //set up names table CheckFiles(FileNames) // GetWidths(fws) // get ears widths // Closes(fws) // close Fonts.Widths WritePressPages(os) let efdlength=WriteExternalFileDir(efScratch,os) Closes(efScratch); DeleteFile("ExternalFiles.Scratch") let fdlength = WriteFontDir(os) WritePartDir(os) WriteDocDir(os,OutputFileName) Closes(os) if Merge then MergeIllusFiles(efdlength,fdlength) if NeedScratchFile then CopyScratchFile() if PrivateStamp then DeleteFile("pressedit.private") WriteEndMessage() ] and CopyScratchFile() be [ Ws("*NCopying to "); Ws(OutputFileName) let os = OpenFile(OutputFileName, ksTypeWriteOnly) let s = OpenFile("pressedit.scratch", ksTypeReadOnly) let np=OutDocDir>>DDV.nrecs // total no to write let pagebuffersize=(FixedLeft()-1000)/256 // no of pages if pagebuffersize le 0 then Error("no room to copy scratch file") let pagebuffer=GetFixed(pagebuffersize lshift 8) until np le 0 do [ let pc=min(np,pagebuffersize) let len=pc lshift 8 ReadBlock(s, pagebuffer, len) WriteBlock(os, pagebuffer, len) np=np-pc ] FreeFixed(pagebuffer) Closes(os) DeleteFile("pressedit.scratch") ] // reads arguments, sets up two vectors: // one contains pointers to file names // other contains -1 for "to" // 0 for number // 1 for file // 2 for font // 3 for illustration file // then these vectors used to construct pl (page list) // which contains file no, page no for every page to put // in output file. Also sets up FileList fn. At end, // NFiles contains no of files in FileList and ReadArgumentList(fn,pl,ef) = valof [ let s = OpenFile("com.cm", ksTypeReadOnly, charItem) let stringvec=vec 100 let switchvec=vec 30 let argvec=vec MaxArgs-1 let typevec=vec MaxArgs-1 if s eq 0 then FileError("com.cm") SetupReadParam(stringvec,switchvec,s,0) CheckSwitches(switchvec) // sets PrivateStamp, Merge if Merge then NeedScratchFile = true let ok=ReadParam("P",0,OutputFileName,0,true) unless ok ne -1 then Error("parameters required: read the documentation") let ok=ReadParam("P",0,0,0,true) // packed string unless ok ne -1 & (EqStr(stringvec,"_") % EqStr(stringvec,"=")) then Error("first parameter should be output file name followed by _ or =") let nargs=0 // index into vectors NFiles=0 NPages=0 XFonts=0 [ let done=ReadParam("P",0,0,0,true) if done eq -1 then break if PageNoFlag(switchvec) then [ SetPageNo(switchvec, stringvec) loop ] typevec!nargs=0 // in case number if nargs ge MaxArgs then Error("too many arguments") unless IsNumber(stringvec,argvec+nargs) then test EqStr(stringvec,"to") % EqStr(stringvec,"t") ifso typevec!nargs=-1 // -1 for 'to' ifnot [ argvec!nargs=CopyString(stringvec) if EqStr(stringvec,OutputFileName) then NeedScratchFile=true typevec!nargs = FontFlag(switchvec) ? 2, 1 ] if Merge ne 0 & (typevec!nargs eq 0 % typevec!nargs eq -1) then Error("No merging into partial document") nargs=nargs+1 ] repeat // if private data stamp, add dummy file // containing font directory if PrivateStamp then [ argvec!nargs=CopyString("pressedit.private") typevec!nargs=1 nargs=nargs+1 WritePresseditPrivate() ] let os = OpenFile(NeedScratchFile? (Merge ? "pressedit.merge", "pressedit.scratch"), OutputFileName, ksTypeWriteOnly) typevec!nargs=1 // to look like another file name // now have all args in two vectors for i=0 to nargs-1 do switchon typevec!i into [ case 0: test typevec!(i-1) eq -1 & typevec!(i-2) eq 0 // a to b ifso for j=argvec!(i-2) to argvec!i do [ (pl+NPages)>>PAGE.filename=NFiles-1 (pl+NPages)>>PAGE.pageno=j NPages=NPages+1 ] ifnot if typevec!(i+1) ne -1 then [ // not 'to' (pl+NPages)>>PAGE.filename=NFiles-1 (pl+NPages)>>PAGE.pageno=argvec!i NPages=NPages+1 ] endcase case 1: fn!NFiles=argvec!i // store filename ptr if typevec!(i+1) ne 0 then [ // no number next (pl+NPages)>>PAGE.filename=NFiles (pl+NPages)>>PAGE.pageno=255 NPages=NPages+1 ] NFiles=NFiles+1 endcase case 2: ef!XFonts=argvec!i XFonts=XFonts+1 endcase case -1: endcase // dealt with next time default: Error("'to' must occur only between page numbers") ] efScratch=OpenFile("ExternalFiles.Scratch", ksTypeReadWrite) resultis os ] and CheckFiles(fl) be [ let ddv=vec 255 InitializeFonts() for fn=0 to NFiles-1 do [ let fname=fl!fn let s = OpenFile(fname, ksTypeReadOnly) if s eq 0 then FileError(fname) let lvec=vec 1 GetFileLength(s,lvec) PositionPage(s, lvec!0) PositionPtr(s, 2*lvec!1) ReadBlock(s, ddv, 256) switchon ddv!0 into [ case PressPassword: PutPressDocDir(ddv,fn,lvec) ReadPressPageDir(s,fn) PrintFileStats(fname,fn) ReadPressFontDir(s,fn) ReadExternalFileDir(s, fn,efScratch) endcase // case EarsPassword: PutEarsDocDir(ddv,fn,lvec) // ReadPressPageDir(s,fn) // PrintFileStats(fname,fn) // ReadEarsFonts(s,fn) // endcase default: Error(fname," is not a Press file") ] Closes(s) ] AddExtraFonts() WriteFontSetCount(MaxSet) if Debug then PrintFontSets() ] // reads page dir unless in PageDir, returns ptr to Font Dir part and ReadPressPageDir(s,fn) be [ let ddv=DocDirList+fn*DDlen if PageDirFile ne fn then [ // not already there SetInFile(s,ddv,ddv>>DD.pdstart,0) let npdw=ddv>>DD.pdrecs lshift 8 // words if npdw gr MaxPageDir then Error("page directory too big") ReadBlock(s, PageDir, npdw) // get page dir PageDirFile=fn ] // unless IsPressFile(fn) then ConvertPageDir(fn) let pagecount=0 let fp=0 for i=0 to ddv>>DD.nparts-1 do [ let p=PageDir+i*PDlen // ptr to page dir entry if p>>PD.pstart+p>>PD.precs gr ddv>>DD.nrecs then Error("incorrect page directory entry") switchon p>>PD.type into [ case 0: // Part "printed page" pagecount=pagecount+1 endcase case 1: // Part "font directory" fp=p endcase case 2: // Part "external file list dir" ddv>>DD.efdstart=p>>PD.pstart ddv>>DD.efdrecs=fp>>PD.precs endcase ] ] if fp eq 0 then Error("no font directory") ddv>>DD.fdstart=fp>>PD.pstart ddv>>DD.fdrecs=fp>>PD.precs ddv>>DD.npages=pagecount ] and PrintFileStats(fname,fn) be [ if PrivateStamp ne 0 & fn eq NFiles-1 then return // don't print pressedit.private let ddv=DocDirList+fn*DDlen Ws(fname) Puts(dsp, $*S) Wns(dsp, ddv>>DD.npages) Wl("-page Press file") ]