//EmPressParse.bcplparse Press files for merging
//Rick Tiberi

//as of October 21, 1977 10:33 AM

get "PressFile.d"
get "Streams.d"

external
[
//outgoing:
isPressFile; pagePosition;
DoubleShift
CopyPressFile; MergePressFile
addresseesFinished

//from O.S.:
FileLength; FilePos; SetFilePos; PositionPage;
ReadBlock; WriteBlock;
Allocate; Free; MoveBlock; DoubleSub;
OpenFile; Gets; Puts; Closes; Endofs
Ws; Wo; Wns; Wss;
dsp; keys; sysZone

//from packages:
DoubleCop; DoubleAdd;
CreateStringStream; StringCompare;

//from Empress1:
WritePart; WriteCommand; PutCommandByte;
AddFontEntry; PutEntityTrailer;
pressFile; inputNames; currentInputName; partDir;
addresseeName

//from Empress:
numCopies; keyString; titleString; docName
]

manifest
[
EHlen = size EH/16
maxEntities = 100
EShortShowMax = #37
EShortSpaceMax = #7
FontMax = #17
controlZ = $Z-$A+1
maxAddresseeLines = 10
maxCopies = 120
]

static
[
DoubleStack
DoubleStackLength
DoubleStackPtr
addresseeStream
addresseeLine
addresseeLines
addresseesFinished = false
alreadySetUp = false
lastX
lastY
]

//-------------------------------------------------------------------
// a Part Directory is composed of Part Entries:
structure PD ↑1,99: @PE
//-------------------------------------------------------------------
structure String: [ length byte; char↑1,255 byte ]
//-------------------------------------------------------------------

//-------------------------------------------------------------------
let isPressFile(stream,buffer,lvLastPage;numargs N) = valof
//-------------------------------------------------------------------
[
let fPos = vec 1
if (FileLength(stream,fPos) & #777) eq 0 then
[ //it has a likely length...
let lastPage = pagePosition(fPos)
if N ge 3 then @lvLastPage = lastPage
DoubleSub(fPos,table [ 0; 512 ])
SetFilePos(stream,fPos)
ReadBlock(stream,buffer,256)
if buffer>>DDV.Passwd eq PressPasswd
then resultis true
]
resultis false
]

//-------------------------------------------------------------------
and pagePosition(fPos) = fPos!1 rshift 9 + fPos!0 lshift 7
//-------------------------------------------------------------------

//-------------------------------------------------------------------
and DoubleShift(dblwordlv,amount) = valof//from SpruceUtils
//-------------------------------------------------------------------
[
test amount ls 0
ifso//Left shift
[
amount = -amount
let temp=(dblwordlv!1) rshift (16-amount)
@dblwordlv=(@dblwordlv lshift amount)+temp
dblwordlv!1=(dblwordlv!1) lshift amount
]
ifnot
[
let temp=@dblwordlv lshift (16-amount)
@dblwordlv=@dblwordlv rshift amount
dblwordlv!1=((dblwordlv!1) rshift amount)+temp
]
resultis dblwordlv!1
]

//-------------------------------------------------------------------
and InitDoubleStack(length) be
//-------------------------------------------------------------------
[
DoubleStack = Allocate(sysZone,length)
DoubleStackLength = length
DoubleStackPtr = DoubleStack
]

//-------------------------------------------------------------------
and FinishDoubleStack() be Free(sysZone,DoubleStack)
//-------------------------------------------------------------------

//-------------------------------------------------------------------
and DoublePush(doublet) = valof
//-------------------------------------------------------------------
[
if DoubleStackPtr ge DoubleStack+DoubleStackLength
then resultis false
DoubleCop(DoubleStackPtr,doublet)
DoubleStackPtr=DoubleStackPtr+2
resultis true
]

//-------------------------------------------------------------------
and DoublePop(doublet) = valof
//-------------------------------------------------------------------
[
if DoubleStackPtr le DoubleStack
then resultis false
DoubleStackPtr=DoubleStackPtr-2
DoubleCop(doublet,DoubleStackPtr)
resultis true
]

//-------------------------------------------------------------------
and MergePressFile(outputStream,inputStream,auxInputStream) be
//-------------------------------------------------------------------
[
let docDir = Allocate(sysZone,256)
unless isPressFile(inputStream,docDir)
do error("[MergePressFile] Not a Press file: ", inputNames!currentInputName)

let partDirectory = Allocate(sysZone,256*docDir>>DDV.pdRecs)
PositionPage(inputStream,(docDir>>DDV.pdStart)+1)
ReadBlock(inputStream,partDirectory,256*docDir>>DDV.pdRecs)

let numParts = docDir>>DDV.nParts
unless numParts eq 2
do error("[MergePressFile] Must have exactly one page: ", inputNames!currentInputName)
Free(sysZone, docDir)

//search for font directory:
for p = 1 to numParts do
[
if partDirectory>>PD↑p.Type eq PETypeFont then
[
CopyFonts(lv (partDirectory>>PD↑p),inputStream)
break
]
]

//do all pages:
for p = 1 to numParts do
[
if partDirectory>>PD↑p.Type eq PETypePage
then CopyPage(lv (partDirectory>>PD↑p), inputStream,auxInputStream)
]

Free(sysZone, partDirectory)
]

//-------------------------------------------------------------------
and CopyPressFile(stream,pressFile,DLstream) be
//-------------------------------------------------------------------
[
let docDir = Allocate(sysZone,256)
unless isPressFile(stream,docDir)
do error("[CopyPressFile] Not a Press file.")

let partDirectory = Allocate(sysZone,256*docDir>>DDV.pdRecs)
PositionPage(stream,(docDir>>DDV.pdStart)+1)
ReadBlock(stream,partDirectory,256*docDir>>DDV.pdRecs)

let numParts = docDir>>DDV.nParts
Free(sysZone, docDir)

//search for font directory:
for p = 1 to numParts do
[
if partDirectory>>PD↑p.Type eq PETypeFont then
[
CopyFonts(lv (partDirectory>>PD↑p),stream)
break
]
]

//do all pages:
for p = 1 to numParts do
[
if partDirectory>>PD↑p.Type eq PETypePage then
[
CopyPage(lv (partDirectory>>PD↑p),stream,DLstream)
WritePart(partDir,pressFile,false)
]
]

Free(sysZone, partDirectory)
]

//-------------------------------------------------------------------
and CopyPage(part, ELstream, DLstream) be
//-------------------------------------------------------------------
[
//part is a PE structure, with type = PETypePage
if part>>PE.Type ne PETypePage then error("[CopyPage] Entry not a page")

PositionPage(ELstream, (part>>PE.pStart)+(part>>PE.pRecs)+1)
let ePos = vec 1; FilePos(ELstream,ePos)

let pad = vec 1; pad!0 = 0; pad!1 = part>>PE.Padding+1
DoubleShift(pad,-1) //*2
DoubleSub(ePos,pad)
SetFilePos(ELstream,ePos) //now pointing at length of last entity

InitDoubleStack(maxEntities*2)
[
let length = vec 1; length!0 = 0
ReadBlock(ELstream,length+1,1)
if length!1 eq 0 then break
FilePos(ELstream,ePos)
unless DoublePush(ePos) //now pointing past entity
do error("[CopyPage] Too many Entities")

DoubleShift(length,-1) //*2
DoubleSub(ePos,length)
DoubleSub(ePos,table[ 0; 2 ] ) //before length
SetFilePos(ELstream,ePos)
] repeat

// Process all entities in order
let entity = Allocate(sysZone, EHlen)
while DoublePop(ePos) do
[
DoubleSub(ePos,table[ 0; EHlen*2 ])
SetFilePos(ELstream,ePos)
let trailerPos = vec 1
DoubleCop(trailerPos,ePos)
ReadBlock(ELstream,entity,EHlen)
CopyEntity(part,entity,trailerPos,ELstream,DLstream)
]
Free(sysZone,entity)
FinishDoubleStack()
]

//-------------------------------------------------------------------
and CopyEntity(part,entity,trailerPos,ELstream,DLstream) be
//-------------------------------------------------------------------
[
//set ELstream to start of commands:
let ePos = vec 1
DoubleCop(ePos,trailerPos)
DoubleAdd(ePos,table[ 0; EHlen*2 ])
let length = vec 1
length!0 = 0; length!1 = entity>>EH.Length
DoubleShift(length,-1) //*2
DoubleSub(ePos,length)
SetFilePos(ELstream,ePos)

//set DLstream to start of DL:
PositionPage(DLstream, (part>>PE.pStart)+1)
let dPos = vec 1; FilePos(DLstream,dPos)
let start = lv entity>>EH.Dstart
DoubleAdd(dPos,start)
SetFilePos(DLstream,dPos)

let entityStart = vec 1
FilePos(pressFile,entityStart)

until ePos!0 eq trailerPos!0 & ePos!1 eq trailerPos!1 do
[
let command = Gets(ELstream)
unless intercepted(command,ELstream,DLstream,ePos,trailerPos)
do CopyCommand(command,ELstream,DLstream,pressFile)
FilePos(ELstream,ePos)
]
PutEntityTrailer(entity,pressFile)
]


//-------------------------------------------------------------------
and CopyCommand(command,ELstream,DLstream,pressFile) be
//-------------------------------------------------------------------
[
PutCommandByte(command)
switchon command into
[
case EShow:
case ESkip:
[ //one-byte count of bytes in DL
let count = Gets(ELstream)
PutCommandByte(count)
for i = 1 to count do Puts(pressFile,Gets(DLstream))
endcase
]
case EShowShort to EShowShort+EShortShowMax:
case ESkipShort to ESkipShort+EShortShowMax:
[ //embedded count of bytes in DL
let count = command-EShowShort+1
for i = 1 to count do Puts(pressFile,Gets(DLstream))
endcase
]
case EShowSkip to EShowSkip+EShortShowMax:
[ //embedded count of bytes in DL + one DL byte
let count = command-EShowSkip+2
for i = 1 to count do Puts(pressFile,Gets(DLstream))
endcase
]
case ESkipControl:
[ //two-byte count of bytes in DL + type
let count = CopyELWord(ELstream)
for i = 1 to count do Puts(pressFile,Gets(DLstream))
PutCommandByte(Gets(ELstream))
endcase
]
case ESkipControlImmediate:
[ //one-byte count of bytes in EL
let count = Gets(ELstream)
PutCommandByte(count)
for i = 1 to count do PutCommandByte(Gets(ELstream))
endcase
]
case EShowRectangle:
[ //2 two-byte literals
PutCommandByte(Gets(ELstream))
PutCommandByte(Gets(ELstream))
PutCommandByte(Gets(ELstream))
PutCommandByte(Gets(ELstream))
endcase
]
case ESetX:
[ //two-byte literal
let high = Gets(ELstream)
PutCommandByte(high)
let low = Gets(ELstream)
PutCommandByte(low)
lastX = high lshift 8 + low
endcase
]
case ESetY:
[ //two-byte literal
let high = Gets(ELstream)
PutCommandByte(high)
let low = Gets(ELstream)
PutCommandByte(low)
lastY = high lshift 8 + low
endcase
]
case ESpaceX:
case ESpaceY:
[ //two-byte literal
PutCommandByte(Gets(ELstream))
PutCommandByte(Gets(ELstream))
endcase
]
case EOnlyOnCopy:
case ESetBright:
case ESetHue:
case ESetSat:
case EShowImmediate:
case ESpaceXShort to ESpaceXShort+EShortSpaceMax:
case ESpaceYShort to ESpaceYShort+EShortSpaceMax:
[ //one-byte literal
PutCommandByte(Gets(ELstream))
endcase
]
case EShowObject:
[ //two-byte count of DL words
let count = vec 1;
count!0 = 0
count!1 = CopyELWord(ELstream)
CopyDLWords(pressFile,DLstream,count)
endcase
]
case EShowDots:
case EShowDotsOpaque:
[ //four-byte count of DL words
let count = vec 1;
count!0 = CopyELWord(ELstream)
count!1 = CopyELWord(ELstream)
CopyDLWords(pressFile,DLstream,count)
endcase
]
case EAlternative:
[ //two-byte EL literal + four-byte count of EL bytes + four-byte count of DL bytes
let count = vec 1;
count!0 = CopyELWord(ELstream)
count!1 = CopyELWord(ELstream)
until count!0 eq 0 & count!1 eq 0 do
[
PutCommandByte(Gets(ELstream))
DoubleSub(count,table[ 0; 1 ])
]
count!0 = CopyELWord(ELstream)
count!1 = CopyELWord(ELstream)
until count!0 eq 0 & count!1 eq 0 do
[
Puts(pressFile,Gets(DLstream))
DoubleSub(count,table[ 0; 1 ])
]
endcase
]
]
]

//-------------------------------------------------------------------
and CopyFonts(part,stream) be
//-------------------------------------------------------------------
[
PositionPage(stream, (part>>PE.pStart)+1)
let length = nil; ReadBlock(stream,lv length,1)
while length ne 0 do
[
let font = Allocate(sysZone,length)
ReadBlock(stream,font+1,length-1)
font!0 = length
AddFontEntry(font)
Free(sysZone,font)
ReadBlock(stream,lv length,1)
]
]

//-------------------------------------------------------------------
and CopyELWord(stream) = valof
//-------------------------------------------------------------------
[
let wordHigh = Gets(stream)
PutCommandByte(wordHigh)
let wordLow = Gets(stream)
PutCommandByte(wordLow)
resultis (wordHigh lshift 8) + wordLow
]

//-------------------------------------------------------------------
and CopyDLWords(outputStream,inputStream,count) be
//-------------------------------------------------------------------
[
//count is double-word count of words of DL to copy

structure [ LH byte; RH byte ]
let buffer = Allocate(sysZone,256)
until count!0 eq 0 & (count!1)<<LH eq 0 do
[
ReadBlock(inputStream,buffer,256)
WriteBlock(outputStream,buffer,256)
DoubleSub(count,table[ 0; 256 ])
]
unless (count!1)<<RH eq 0 do
[
ReadBlock(inputStream,buffer,(count!1)<<RH)
WriteBlock(outputStream,buffer,(count!1)<<RH)
]
Free(sysZone,buffer)
]

//-------------------------------------------------------------------
and intercepted(command,ELstream,DLstream,startPos,trailerPos) = valof
//-------------------------------------------------------------------
[
if addresseeName eq 0 then resultis false
let count = nil
switchon command into
[
case EShow:
count = Gets(ELstream)
endcase
case EShowShort to EShowShort+EShortShowMax:
count = command-EShowShort+1
endcase
default: resultis false
]
let string = Allocate(sysZone,128)
test MatchesKey(DLstream,count,string)
ifso InsertAddressees(ELstream,DLstream,startPos,trailerPos)
ifnot test StringCompare(string,titleString) eq 0
ifso
[
let string = docName eq 0? " ",docName
Wss(pressFile,string)
WriteCommand(EShow,string>>String.length)
]
ifnot
[
Wss(pressFile,string)
WriteCommand(EShow,string>>String.length)
]
Free(sysZone,string)
resultis true
]

//-------------------------------------------------------------------
and InsertAddressees(ELstream,DLstream,startPos,trailerPos) be
//-------------------------------------------------------------------
[
let string = Allocate(sysZone,128)
let endPos = vec 1; FilePos(ELstream,endPos)
let DLPos = vec 1
until endPos!0 eq trailerPos!0 & endPos!1 eq trailerPos!1 do
[
FilePos(DLstream,DLPos)
let command = Gets(ELstream)
switchon command into
[
case EShow:
unless MatchesKey(DLstream,Gets(ELstream),string) break
endcase
case EShowShort to EShowShort+EShortShowMax:
unless MatchesKey(DLstream,command-EShowShort+1,string) break
endcase
case ESetX:
case ESetY:
Gets(ELstream)
Gets(ELstream)
endcase
case EFont:
endcase
default: break
]
FilePos(ELstream,endPos)
]
SetFilePos(DLstream,DLPos) //to where non-match started
Free(sysZone,string)

//now that we’ve found where, go back and insert addressees
SetUpAddressees()
let copy = 1
until addresseesFinished % copy gr maxCopies do
[
WriteCommand(EOnlyOnCopy,copy)
WriteCommand(ESetX, lastX)
WriteCommand(ESetY, lastY)
SetFilePos(ELstream,startPos)
let pos = vec 1; DoubleCop(pos,startPos)
until pos!0 eq endPos!0 & pos!1 eq endPos!1 do
[
let command = Gets(ELstream)
switchon command into
[
case EShow:
ShowAddressee(Gets(ELstream),DLstream)
endcase
case EShowShort to EShowShort+EShortShowMax:
ShowAddressee(command-EShowShort+1,DLstream)
endcase
case ESetX:
case ESetY:
PutCommandByte(command)
PutCommandByte(Gets(ELstream))
PutCommandByte(Gets(ELstream))
endcase
case EFont:
PutCommandByte(command)
endcase
]
FilePos(ELstream,pos)
]
NextAddressee()
copy = copy+1
]
WriteCommand(EOnlyOnCopy,0)
numCopies = copy-1
CloseAddressees()
]

//-------------------------------------------------------------------
and MatchesKey(stream,count,string) = valof
//-------------------------------------------------------------------
[
let ss=CreateStringStream(string,255)
for i = 1 to count do Puts(ss,Gets(stream))
Closes(ss)
resultis StringCompare(string,keyString) eq 0
]

//-------------------------------------------------------------------
and SetUpAddressees() be
//-------------------------------------------------------------------
[
if alreadySetUp return
alreadySetUp = true
addresseeLines=Allocate(sysZone,maxAddresseeLines)
let name = CreateStringStream(addresseeName)
test Gets(name) eq $"
ifnot addresseeStream = OpenFile(addresseeName, ksTypeReadOnly, charItem)
ifso
[
let string = Allocate(sysZone,128)
addresseeStream = CreateStringStream(string,255)
until Endofs(name) do
[
let ch = Gets(name)
if ch eq $" break
if ch eq $- then ch = $*S
Puts(addresseeStream,ch)
]
Puts(addresseeStream,$*N)
Closes(addresseeStream)
addresseeStream = CreateStringStream(string)
]
Closes(name)
for i = 0 to maxAddresseeLines-1
do addresseeLines!i = Allocate(sysZone,128)
addresseesFinished=false
NextAddressee()
]

//-------------------------------------------------------------------
and ShowAddressee(count,stream) be
//-------------------------------------------------------------------
[
if addresseeLine eq maxAddresseeLines
then error("[ShowAddressee] Too many lines for addressee")
//for i = 1 to count do Gets(stream)
Wss(pressFile,addresseeLines!addresseeLine)
WriteCommand(EShow,(addresseeLines!addresseeLine)>>String.length)
addresseeLine=addresseeLine+1
]

//-------------------------------------------------------------------
and NextAddressee() be
//-------------------------------------------------------------------
[
if Endofs(addresseeStream)
then [ addresseesFinished = true; return ]
let ch = 0
for i = 0 to maxAddresseeLines-1 do
[
let ss = CreateStringStream(addresseeLines!i,255)
test Endofs(addresseeStream) % ch eq controlZ
ifso Puts(ss,$*S)
ifnot
[
ch = Gets(addresseeStream)
until Endofs(addresseeStream)
% ch eq $*N % ch eq controlZ do
[
Puts(ss,ch)
ch = Gets(addresseeStream)
]
Puts(ss,$*S)
]
Closes(ss)
]
until Endofs(addresseeStream) % ch eq $*N
do ch = Gets(addresseeStream)
addresseeLine=0
]

//-------------------------------------------------------------------
and CloseAddressees() be
//-------------------------------------------------------------------
[
unless addresseesFinished return
for i = 0 to maxAddresseeLines-1
do Free(sysZone,addresseeLines!i)
Closes(addresseeStream)
alreadySetUp = false
]

//-------------------------------------------------------------------
and error(s1,s2;numargs N) be
//-------------------------------------------------------------------
[
Ws(s1)
if N ge 2 then Ws(s2)
abort
]