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