// bcpl/f PressEdit.bcpl -- merge, page edit press files
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// 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.2 of August 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")
]