// Merge code for Pressedit
// bcpl/f presseditmerge.bcpl
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last edited by
// Bob Sproull Oct 9, 1982. Fixed bug in MergePressPages causing
// infinite loop if missing file or arrow; added check for exceeding
// maximum number of illustrations
// Lyle Ramshaw May 29, 1982 2:44 PM Added the /A switch as an
// alternative to the /M, in which all illustrations are merged into
// all pages without any checking for arrows on either side, and
// without any shifting in position.
// Lyle Ramshaw January 14, 1982 3:18 PM allow for high order
// word of data list dyte start to be non-zero
// Also fix up SetupEntities to allow for large file addresses
// Lyle Ramshaw January 14, 1981 11:19 AM fix bounds check on EntVec
// RML August 13, 1980 6:22 PM add external files
// RML July 25, 1980 3:13 PM check bounds on EntVec
// William Newman February 8, 1978 10:51 PM fixed draw files bug
get "presseditdefs.bcpl"
get "streams.d"
// outgoing procedures
external [
// EarsArrowCheck
MergeIllusFiles
PressMergeScan
PressScan
]
// outgoing statics
// incoming procedures
external [
// in presseditfns
AppendChar
AppendString
EqStr
Error
nth
pnth
min
// in presseditpage
CopyPressPage
FixPartDir
WritePartDir
WriteDocDir
CopyPages
CopyWords
PGread
PutPadding
// in new OS
Zero
OpenFile
Gets
Puts
Closes
DeleteFile
PositionPage
PositionPtr
FilePos
SetFilePos
DoubleAdd
ReadBlock
WriteBlock
Ws
Wl
Wns
CallSwat
]
// incoming statics
external [
dsp
FileNames
NFiles
Merge
mergeList
nIllus
mergePtr
docMergePtrs
illusMergePtrs
OutPartDir
OutPartDirPtr
OutDocDir
OutputFileName
EntVec
InputStream
InputByteStream
DocDirList
]
static
[
pressX
pressY
xMin
yMin
elByte
elWord
pressPass
]
manifest
[
chardrop = 100 // allows for drop below char baseline
maxleft = 85*254
maxbottom = 11*2540
markupglitch = 31744 // weird number markup puts in
]
// checks for one string starting with <==<<
// if so, adds entry to mergelist, increments nIllus
// ignores if name not in FileNames
let MergeFileNo(filename) = valof
[
if nth(filename, 0) eq 0 then resultis 0
// test for ligature
let tv = vec 30
tv!0 = 0
for i = 1 to nth(filename, 0) do
[
let c = nth(filename, i)
test c eq #24 // control-T
ifso AppendString(tv, "fi")
ifnot AppendChar(tv, c)
]
for i = 0 to NFiles-1 do
if EqStr(tv, FileNames!i) then resultis i
resultis -2
]
and
let MergeIllusFiles(efdlength,fdlength) be
[
Wl("*nMerging files:")
let ddv = vec DDlen - 1
SetUpMergeDD(ddv, fdlength)
OutPartDirPtr = OutPartDir // gradually overwrite part dir
// note that output file has same number of parts as
// first input file; therefore OutPartDirPtr addresses
// both input part and (after fixup) output part
// after merging, Ptr points to first part of first
// merge file: font part is written here
let os = OpenFile("pressedit.scratch", ksTypeWriteOnly)
InputStream = OpenFile("pressedit.merge", ksTypeReadOnly)
test Merge eq $A
ifso
[
for pn=0 to DocDirList>>DD.npages-1 do
MergePressPages(os, OutPartDirPtr, mergeList,
mergeList+nIllus*MERGElen,pn)
]
ifnot //so, Merge eq $M
[
let pn = 0
[
if docMergePtrs!(pn+1) eq -1 then break // last page done
test docMergePtrs!pn eq 0
ifso CopyPressPage(os, OutPartDirPtr, ddv)
ifnot
[
let i = pn + 1
until docMergePtrs!i ne 0 do i = i + 1
// gives next non-zero ptr
MergePressPages(os, OutPartDirPtr, docMergePtrs!pn,
docMergePtrs!i, pn)
]
pn = pn + 1
] repeat
]
// fix directories: external file directory first, if present
unless efdlength eq 0 do [
PositionPage(InputStream, OutDocDir>>DDV.pdstart - efdlength - fdlength +1)
ReadBlock(InputStream, EntVec, efdlength lshift 8)
WriteBlock(os, EntVec, efdlength lshift 8)
FixPartDir(0, os) // sets type to 0
(OutPartDirPtr - PDlen)>>PD.type = 2
]
// font directory
PositionPage(InputStream, OutDocDir>>DDV.pdstart - fdlength +1)
ReadBlock(InputStream, EntVec, fdlength lshift 8)
WriteBlock(os, EntVec, fdlength lshift 8)
FixPartDir(0, os) // sets type to 0
(OutPartDirPtr - PDlen)>>PD.type = 1
// part directory
WritePartDir(os)
// doc directory
WriteDocDir(os, OutputFileName)
Closes(os)
Closes(InputStream)
DeleteFile("pressedit.merge")
]
and
let MergePressPages(os, pv, fp, lp, pn) be
[
let evec = vec MaxEntities - 1
let entcount = SetupEntities(pv, evec, os, EntVec)
Ws("page "); Wns(dsp, pn+1); Puts(dsp, $:)
let p=fp
until p eq lp do
[
let nextp=p+(Merge eq $A? 2*MERGElen, MERGElen)
Puts(dsp, $*s)
if p>>MERGE.file eq 0 then loop
if p>>MERGE.file eq -2 then
[
Ws("missing file ")
p=nextp
loop
]
Ws(FileNames!(p>>MERGE.file))
let pp = (Merge eq $A? p+MERGElen, @(illusMergePtrs + p>>MERGE.file))
if pp eq 0 then
[
Ws("(no arrow in figure)")
p=nextp
loop
]
// illus entry
let fpv = OutPartDir + (pp>>MERGE.file)*PDlen // part
let lastent = evec!0
let nbytes = vec 1
nbytes!0=0; nbytes!1=0;
if lastent ne EntVec then
[ DoubleAdd(nbytes, lv lastent>>EH.dstart1)
DoubleAdd(nbytes, lv lastent>>EH.dlength1) ]
entcount = SetupEntities(fpv, evec, os, lastent + EHlen)
let negorg = false // look for -ve xe, ye
for i = 0 to entcount-1 do
[
let ep = evec!i // ptr to entity
ep>>EH.xe = ep>>EH.xe + p>>MERGE.x - pp>>MERGE.x
ep>>EH.ye = ep>>EH.ye + p>>MERGE.y - pp>>MERGE.y
if ep>>EH.xe ls 0 % ep>>EH.ye ls 0 then negorg = true
DoubleAdd(lv ep>>EH.dstart1, nbytes)
]
if negorg then Ws(" (negative origin)")
p=nextp
]
Puts(os, 0)
WriteBlock(os, EntVec, evec!0 + EHlen - EntVec)
let wp = PutPadding(os)
FixPartDir(wp, os)
Puts(dsp, $*n)
]
and
let PressMergeScan(evec, entcount, entptr, pdv) be
[
PressScan(evec, entcount, pdv, arrowpass)
PressScan(evec, entcount, pdv, xypass)
]
and
let PressScan(evec, entcount, pdv, pass) be
[
pressPass = pass // to avoid reading DL
let ep = EntVec - EHlen // -1th entity
for i = entcount-1 to 0 step -1 do
[
elWord = ep + EHlen // start of next entity code
elByte = 0
ep = ep + evec!i // entity trailer first word
// check for funny Markup values
if ep>>EH.xleft gr maxleft then
ep>>EH.xleft = ep>>EH.xleft - markupglitch
if ep>>EH.ybottom gr maxbottom then
ep>>EH.ybottom = ep>>EH.ybottom - markupglitch
let xright = ep>>EH.xe + ep>>EH.xleft + ep>>EH.width
let ytop = ep>>EH.ye + ep>>EH.ybottom + ep>>EH.height
// not used in xy pass
pressX = ep>>EH.xe // default value
pressY = ep>>EH.ye
xMin = xright // starting value
yMin = ytop
// not used in xy pass
let str = vec 128
let dstart = ep>>EH.dstart2
let objectsfound = false
let movexy = true // reset x, y values
if pass eq xypass & ep>>EH.dstart1 ls 0 then
// bit set for objects
[
ep>>EH.dstart1 = ep>>EH.dstart1 & #77777
movexy = false
]
if pass eq arrowpass then
[
PositionPage(InputByteStream,
pdv>>PD.pstart + 1 + (dstart rshift 9) +
(ep>>EH.dstart1 lshift 7))
PositionPtr(InputByteStream, dstart & #777)
]
while elWord ls ep do
[
let code = GetELByte()
let e = code ls #150 ? code & #140,
code ls #200 ? code & #170,
code ls #240 ? #200,
code ls #353 ? Error("entity code"),
code
switchon e into
[
case #000: // code+1 chars
DoShowString(GetDLString(str, code + 1), #40 + code, 1)
endcase
case #040: // skip code+1-#40 chars
SkipDL(code + 1 - #040)
endcase
case #100: // code+1-#100 chars, skip 1
DoShowString(GetDLString(str, code + 1 - #100),
code - #100 + #41, 1) // note: will fall apart if
// used for arrows, and string is 33 chars long
SkipDL(1)
endcase
case #140: // space-x: eskip 1
GetELByte()
endcase
case #150: // space-y: eskip 1
GetELByte()
endcase
case #160:
case #170: // set font
endcase
case #200: // available
endcase
case #353: // n=eread 1, eskip n
SkipEL(GetELByte())
endcase
case #354: // alt
SkipEL(10)
endcase
case #355: // copy
SkipEL(1)
endcase
case #356: // set x
DoSetX(GetELWord(), ep, movexy)
endcase
case #357: // set y
DoSetY(GetELWord(), ep, movexy)
endcase
case #360: // show chars
DoShowString(GetDLString(str, GetELByte()), #361, 2)
endcase
case #361: // skip chars
SkipDL(GetELByte())
endcase
case #362: // skip control
SkipDL(GetELWord())
SkipEL(1)
endcase
case #363: // show char immediate
SkipEL(1)
endcase
case #364: // set space x
case #365: // set space y
SkipEL(2)
endcase
case #366: // reset space
case #367: // space
endcase
case #370: // brightness
case #371: // hue
case #372: // saturation
SkipEL(1)
endcase
case #373: // show objects
objectsfound = true
SkipDL(GetELWord() lshift 1)
endcase
case #374: // show dots
case #375: // show dots
DoShowDots()
endcase
case #376: // rectangle
SkipEL(4)
endcase
case #377: // noop
endcase
default: Error("unknown entity command")
endcase
]
]
test objectsfound
ifso if pass eq arrowpass then
ep>>EH.dstart1 = ep>>EH.dstart1 % #100000
// set bit where it's always zero
ifnot // can fix entity
test pass eq arrowpass
ifso // save min values
[
ep>>EH.width = xright - xMin // fix it
ep>>EH.height = ytop - yMin // fix it
ep>>EH.xleft = xMin - ep>>EH.xe // temp storage
ep>>EH.ybottom = yMin - ep>>EH.ye
]
ifnot
[
ep>>EH.xe = ep>>EH.xe + ep>>EH.xleft
ep>>EH.ye = ep>>EH.ye + ep>>EH.ybottom
ep>>EH.xleft = 0
ep>>EH.ybottom = 0
]
]
]
and
let GetELByte() = valof
[
let b = elByte eq 0 ? @elWord rshift 8 , @elWord & #377
elByte = 1 - elByte
if elByte eq 0 then elWord = elWord + 1
resultis b
]
and
let GetELWord() = (GetELByte() lshift 8) % GetELByte()
and
let PutBackELWord(w) be
[
elWord = elWord - 1
PutBackELByte(w rshift 8)
PutBackELByte(w & #377)
]
and
let PutBackELByte(b) be
[
@elWord = (@elWord & (elByte eq 0 ? #377, #177400)) %
(elByte eq 0 ? b lshift 8, b)
elByte = 1 - elByte
if elByte eq 0 then elWord = elWord + 1
]
and
let SkipEL(bytes) be
for i = 1 to bytes do GetELByte()
and
let SkipDL(bytes) be
if pressPass eq arrowpass then
[
if bytes ls 0 then
[
let v = vec 1
let bignum = vec 1
bignum!0 = 0
bignum!1 = #100000
FilePos(InputByteStream, v)
DoubleAdd(v, bignum)
SetFilePos(InputByteStream, v)
bytes = bytes & #77777
]
for i = 1 to bytes do Gets(InputByteStream)
]
and
let GetDLString(v, bytes) =
pressPass eq xypass? v, valof
[
v!0 = 0
for i = 1 to bytes do AppendChar(v, Gets(InputByteStream))
resultis v
]
and
let DoShowString(str, elcode, backup) be
if pressPass eq arrowpass & nth(str, 0) ge 5 then
[
let v = vec 30
v!0 = 0
for i = 1 to 4 do AppendChar(v, nth(str, i))
if EqStr(v, "<==<") then
[
v!0 = 0
for i = 5 to nth(str, 0) do
[
if nth(str, i) eq $< then break
if nth(str, i) ne $*s then AppendChar(v, nth(str, i))
]
if nIllus eq maxIllus then
Error("too many illustrations in files.")
let p = mergeList + nIllus*MERGElen
p>>MERGE.file = MergeFileNo(v)
p>>MERGE.x = pressX
p>>MERGE.y = pressY
nIllus = nIllus + 1
if p>>MERGE.file eq -2 then return // not found
// now fix EL
elWord = elWord - ((backup+1) rshift 1) // backup words
if (backup&1) ne 0 then GetELByte() // skip byte
PutBackELByte(elcode)
for i = 2 to backup do GetELByte() // return to place
]
]
and
let DoSetX(x, eh, movexy) be
// if movexy false, do nothing
if movexy then test pressPass eq arrowpass
ifso
[
pressX = x + eh>>EH.xe
xMin = min(pressX, xMin)
]
ifnot PutBackELWord(x - eh>>EH.xleft)
and
let DoSetY(y, eh, movexy) be
// if movexy false, do nothing
if movexy then test pressPass eq arrowpass
ifso
[
pressY = y + eh>>EH.ye
yMin = min(pressY - chardrop, yMin)
]
ifnot PutBackELWord(y - eh>>EH.ybottom)
and
let DoShowDots() be
[
let ub = GetELWord()
if ub ne 0 then Error("huge dots")
let lb = GetELWord()
SkipDL(lb)
SkipDL(lb)
]
// Similar to SetupEntityList in presseditpage
// set up list of entities by reading from file
// pdv is pointer to part-dir entry
// evec is vector of entity lengths, stored in reverse order
// returns no of entities
and SetupEntities(pdv, evec, os, vecaddress) = valof [
if pdv>>PD.precs eq 0 then resultis 0 // empty page
let startrec=pdv>>PD.pstart // set offset
let trecs = pdv>>PD.precs & #177600 // nearest 200
let w=((pdv>>PD.precs & #177) lshift 8)-pdv>>PD.padding-1
let wMinusWStart=0
// let wstart = w
let ec=0
evec!0 = vecaddress // in case 0 ents
[eloop
if w ls 0 then
[
trecs = trecs - #200
w = w + (#200 lshift 8)
]
let l=PGread(startrec + trecs, w) // get length
if l eq 0 then break // done
evec!ec=wMinusWStart // address rel to wstart
ec=ec+1
if ec ge MaxEntities then Error("too many entities")
w=w-l
wMinusWStart=wMinusWStart-l
]eloop repeat
if ec eq 0 then resultis 0
for i = 0 to ec - 1 do
evec!i = vecaddress + evec!i - wMinusWStart - EHlen
// actual address
PositionPage(InputStream, startrec + trecs + (w rshift 8) + 1)
PositionPtr(InputStream, (w & #377)*2 + 2) // past zero wd
if vecaddress-wMinusWStart ge EntVec+(MaxEntBytes/2) then
Error("Too many bytes of entities on one page")
ReadBlock(InputStream, vecaddress, 0 - wMinusWStart) // read EL
let ep = evec!0 // ptr to last entity in EL
// make DL end on word boundary
let dlw=vec 1
if ((ep>>EH.dstart2 + ep>>EH.dlength2) & 1) ne 0 then
DoubleAdd(lv ep>>EH.dlength1, table [ 0;1 ] )
dlw!0=ep>>EH.dstart1; dlw!1=ep>>EH.dstart2
DoubleAdd(dlw, lv ep>>EH.dlength1)
PositionPage(InputStream,startrec+1)
CopyPages(os,(dlw!1 rshift 9)+(dlw!0 lshift 7)) // copy pages of DL
CopyWords(os,(dlw!1 rshift 1)Ź) // rest of DL
resultis ec
]
and
let SetUpMergeDD(ddv, fdlength) be
[
ddv>>DD.pressfile = true
ddv>>DD.nrecs = OutDocDir>>DDV.nrecs
ddv>>DD.nparts = OutDocDir>>DDV.nparts
ddv>>DD.npages = OutDocDir>>DDV.nparts - 1
ddv>>DD.pdstart = OutDocDir>>DDV.pdstart
ddv>>DD.fdstart = OutDocDir>>DDV.pdstart - fdlength
ddv>>DD.pdrecs = OutDocDir>>DDV.pdrecs
ddv>>DD.fdrecs = fdlength
ddv>>DD.nsets = 0
ddv>>DD.pref = 0
]