// bcpl/f PressEditPage.bcpl
// press edit page output

// Last edited by Lyle Ramshaw January 13, 1982 3:38 PM
// Last edited by RML August 12, 1980 1:56 PM
// RML June 25, 1979 11:46 AM
// rotated fonts

// Copyright Xerox Corporation 1979, 1980, 1982

get "presseditdefs.bcpl"
get "streams.d"
get "AltoFileSys.d"
get "time.d"

// outgoing procedures

external [
CopyPressPage
CopyPages
CopyWords
FixPartDir
PGread
PutPrivateDL
PutPrivateEL
PutPadding
ReadExternalFileDir
WriteExternalFileDir
WritePressPages
WriteFontDir
WritePartDir
WriteDocDir
]

// outgoing statics

external
[
OutPartDirPtr
]

static [
OutPartDirPtr
]

// incoming procedures

external [
BlankSet
CompareSets
CheckFontEntry
//ConvertEarsPage
CopyString
DecodeFontName
EqStr
EqChar
IsPressFile
Resets
ReadPressPageDir
PressMergeScan
FontFlag
IsNumber
IsDigit
GetFileLength
WFACE
AppendFace
SetInFile
Error
FileError
nth
pnth
utilinit
radixconvert
max
min
AppendChar
FilePage
UNPACKDT
CONVUDT
OpenFile
Gets
Puts
Closes
Ws
FileLength
PositionPage
PositionPtr
MoveBlock
Zero
ReadCalendar
DoubleAdd
FilePos
GetFixed
FixedLeft
FreeFixed
WriteBlock
ReadBlock
Wns
]

// incoming statics

external [
DLByteCount
DocDirList
docMergePtrs
dsp
efCount
//EarsFontSets
EntByteCount
EntVec
FamilyDir
FileNames
FontSets
illusMergePtrs
InputStream
InputByteStream
MaxSet
Merge
mergeList
mergePtr
NPages
NFiles
nIllus
PageList
PageDir
PageDirFile
PrivateStamp
OutPartDir
OutDocDir
pageNoStart
pageNoX
pageNoY
pageNoOmit
SetMapTable
UserName
]

manifest [
toppage=100+10*2540
bottompage=200
stampx=7*2540
]

structure PS: [
esetxbit 8
xlbit 8
xrbit 8
esetybit 8
yword
efontbit 4
fontbit 4
showcbit 8
]

manifest [ PSlen=size PS/16 ]

structure RCT: [
esetxbit 8
xlbit 8
xrbit 8
esetybit 8
yword
erectword
wword
hword
]

manifest [ RCTlen=size RCT/16 ]

// if there is an External file directory, read it and dump it to
// a disk file.

let ReadExternalFileDir(s,fn,outS) be [
let ddv=DocDirList+fn*DDlen
if ddv>>DD.efdstart eq 0 then return// there isn’t one.
SetInFile(s,ddv,ddv>>DD.efdstart,0)
efCount=efCount+TransferExternalFileDir(s,outS)
]

and WriteExternalFileDir(inStr, outStr)=valof [
Puts(inStr,0)// Terminate the scratch file
Resets(inStr)
if efCount eq 0 then resultis 0
unless efCount eq TransferExternalFileDir(inStr,outStr) do Error("External File Directory error")
Puts(outStr,0)// Terminate Dir
efCount=efCount+1
resultis AddPart(2,PadOut(outStr,efCount))
]

and TransferExternalFileDir(inStr,outStr)=valof [
let count=0
let t=Gets(inStr)
until t eq 0 do [
let wdLength=t<<STRING.length/2+1
for i=1 to wdLength do [
Puts(outStr,t); t=Gets(inStr)]
count=count+wdLength
]
resultis count
]

and AddPart(type,nwds) = valof [
Zero(OutPartDirPtr, PDlen)
OutPartDirPtr>>PD.type=type
OutPartDirPtr>>PD.pstart=NextPartRec(OutPartDirPtr)
OutPartDirPtr>>PD.precs=nwds rshift 8
OutPartDirPtr=OutPartDirPtr+PDlen
resultis nwds rshift 8
]

and WritePressPages(os) be [
let npart=0// page 0
let openfile=-1// none open
let firstfile = true
nIllus = 0
InputStream=0
InputByteStream=0
OutPartDirPtr=OutPartDir
if NPages eq 0 then [
WriteBlankPage(os)
return
]
if PrivateStamp eq $P then
[
let pnomit = pageNoOmit + 1
Ws("*nNumbering pages from ")
Wns(dsp, pageNoStart)
Ws(", starting on ")
Wns(dsp, pnomit)
let prem = pnomit rem 10
Ws(prem eq 1 ? "st", prem eq 2? "nd", prem eq 3? "rd", "th")
Ws(" page")
]
for x=0 to NPages-1 do [// each entry in PageList
let fn=(PageList+x)>>PAGE.filename
let pn=(PageList+x)>>PAGE.pageno
let lpn=pn// if last page=first
let ddv=DocDirList+fn*DDlen
if fn ne openfile then [
Puts(dsp, $*N); Ws(FileNames!fn); Puts(dsp, $:)
if openfile ne -1 then
[ Closes(InputStream); firstfile = false ]
if InputByteStream ne 0 then
Closes(InputByteStream)
InputStream=OpenFile(FileNames!fn, ksTypeReadOnly)
InputByteStream= IsPressFile(fn) ne 0 &
Merge eq 0 ? 0, OpenFile(FileNames!fn, ksTypeReadOnly, charItem)
openfile=fn
]
if fn ne PageDirFile then
ReadPressPageDir(InputStream,fn)
if pn eq #377 then [ pn=1; lpn=ddv>>DD.npages ]
for pgno=pn to lpn do
[
let mp = nil
if Merge then
[
mergePtr = firstfile? docMergePtrs + pgno - 1,
illusMergePtrs + fn
mp = mergeList + nIllus*MERGElen
// pointer to first entry for page
@mergePtr = mp
@(mergePtr+1) = 0// terminates list
]
let oldnillus = nIllus
if WritePressPage(pgno-1,os,fn) then [
npart=npart+1
Puts(dsp, $*S); Wns(dsp, pgno)
]
if (Merge eq $A) & (firstfile eq false) then
[
mp>>MERGE.file=fn; mp>>MERGE.x=0; mp>>MERGE.y=0
nIllus = nIllus+1
mp = mergeList + nIllus*MERGElen
mp>>MERGE.file=npart-1; mp>>MERGE.x=0; mp>>MERGE.y=0
nIllus = nIllus+1
@mergePtr = mp
@(mergePtr+1) = mergeList + nIllus*MERGElen
]
if Merge eq $M then
[
if nIllus eq oldnillus then @mergePtr = 0// no figs
if nIllus ne oldnillus & firstfile eq false then
mp>>MERGE.file = npart - 1
// put part no in MERGE structure
@(mergePtr+1) = mergeList + nIllus*MERGElen
// pointer to next free entry terminates list
@(mergePtr+2) = -1// followed by -1
]
]
]
Closes(InputStream)
if InputByteStream ne 0 then Closes(InputByteStream)
]

and WriteBlankPage(os) be [

for i=1 to 256 do Puts(os, 0)
Zero(OutPartDirPtr, PDlen)
OutPartDirPtr>>PD.type=0
OutPartDirPtr>>PD.pstart=0
OutPartDirPtr>>PD.precs=1
OutPartDirPtr>>PD.padding=255
OutPartDirPtr=OutPartDirPtr+PDlen
]

and WritePressPage(pn,os,fn) = valof [

let ddv=DocDirList+fn*DDlen
let pv=FindPart(pn,ddv)
if pv eq 0 then resultis false
test IsPressFile(fn)
ifso [
test SetMapTable!fn eq 0 & PrivateStamp eq 0 & Merge eq 0
ifso CopyPressPage(os,pv,ddv)
ifnot MapPressPage(os,pv,SetMapTable!fn,ddv)
]
ifnot [
Error(fn, "Not a Press File")
//ConvertEarsPage(ddv,pv,os,fn,EarsFontSets!pn)
//let wp=PutPadding(os)
//FixPartDir(wp,os)
]
resultis true
]

// copy page, no font set mapping

and CopyPressPage(os,pv,ddv) be [

SetInFile(InputStream,ddv,pv>>PD.pstart,0)
CopyPages(os,pv>>PD.precs)
FixPartDir(pv>>PD.padding,os)
]

and MapPressPage(os,pv,mp,ddv) be [

let evec=vec MaxEntities-1
let bc=vec 1// for file posn
FilePos(os,bc)// at start
let entcount=SetupEntityList(pv,evec,os,ddv)
if PrivateStamp ne 0 then PutPrivateDL(os,bc)
let entptr = EntVec
for i=entcount-1 to 0 step -1 do [
if entptr + evec!i - EntVec - MaxEntBytes/2 gr 0 then
Error("page is too complex")
ReadBlock(InputStream, entptr, evec!i - EHlen)
entptr = entptr + evec!i - EHlen
ReadBlock(InputStream, entptr, EHlen)
if mp ne 0 then// mapped set
entptr>>EH.fontset=mp!(entptr>>EH.fontset)
entptr = entptr + EHlen
]
if Merge eq $M then PressMergeScan(evec, entcount, entptr, pv)
WriteBlock(os, EntVec, entptr - EntVec)
if PrivateStamp ne 0 then PutPrivateEL(os,bc)
let pw=PutPadding(os)
FixPartDir(pw,os)
]

and PutPadding(s) = valof [

let wp=(FilePos(s) rshift 1)Ź
if wp eq 0 then resultis 0
for i=wp to 255 do Puts(s, 0)
resultis 256-wp
]

and PutPrivateDL(os,bc) be [

let tc=vec 1
MoveBlock(tc,bc,2)// move start to tc
FilePos(os,bc)
DoubleSubtract(bc,tc)
test PrivateStamp eq $P
ifso
[
let pageno = (OutPartDirPtr - OutPartDir)/PDlen
if pageno ge pageNoOmit then
[
pageno = pageno - pageNoOmit + pageNoStart
let t = "*s*s*s*s*s"
let pns = vec 4
MoveBlock(pns, t, 3)
let ns = vec 6
ns!0 = 0
radixconvert(ns, pageno, 10)
for i = 1 to nth(ns, 0) do
pnth(pns, 5 - nth(ns, 0) + i, nth(ns, i))
WriteBlock(os, pns+1, 2)
]
]
ifnot
[
let t=" XeroxPrivateDataA"
WriteBlock(os, t+1, 9)
]
Puts(os, 0)// end DL
]

and DoubleSubtract(a,b) be [

let one=table [ 0; 1 ]
let v=vec 1
v!0=not b!0
v!1=not b!1
DoubleAdd(v,one)
DoubleAdd(a,v)
]

and PutPrivateEL(s,bc) be
test PrivateStamp eq $P
ifso if (OutPartDirPtr - OutPartDir)/PDlen ge pageNoOmit then
[
let wc=PutString(s,pageNoX,pageNoY,4,0,0)
let eh=table [ 0; 0; 0; 0; 4; 0; 0; 0; 0; 0; 0; 0 ]
if SetMapTable!(NFiles-1) ne 0 then
eh>>EH.fontset=@(SetMapTable!(NFiles-1))
MoveBlock(lv eh>>EH.dstart1,bc,2)
eh>>EH.length=wc+EHlen
WriteBlock(s, eh, EHlen)
]
ifnot
[
let stampy=PrivateStamp eq $T ? toppage, bottompage
let wc=PutString(s,stampx+1500,stampy+1200,5,0,0)
wc=PutString(s,stampx+1500,stampy+850,7,0,wc)
wc=PutString(s,stampx+1500,stampy+500,4,0,wc)
wc=PutString(s,stampx,stampy,1,1,wc) // wc keeps word count
wc=PutBox(s,stampx-100,stampy+250,stampx+2840,stampy+1680,wc)
wc=PutBox(s,stampx-250,stampy+100,stampx+2990,stampy+1830,wc)
let eh=table [ 0; 0; 0; 0; 17; 0; 0; 0; 0; 0; 0; 0 ]
if SetMapTable!(NFiles-1) ne 0 then
eh>>EH.fontset=@(SetMapTable!(NFiles-1))
MoveBlock(lv eh>>EH.dstart1,bc,2)
eh>>EH.length=wc+EHlen
WriteBlock(s, eh, EHlen)
]

and PutString(s,x,y,nc,f,wc) = valof [

let t=table [ ESetX lshift 8; ESetY; 0; EFont lshift 8 ]
t>>PS.xl=x rshift 8
t>>PS.xr=xŹ
t>>PS.y=y
t>>PS.font=f
t>>PS.showc=nc-1
WriteBlock(s, t, PSlen)
resultis wc+PSlen
]

and PutBox(s,x1,y1,x2,y2,wc) = valof [

let w=PutRect(s,x1-20,y1-20,x2-x1+40,40,wc)
w=PutRect(s,x1-20,y1-20,40,y2-y1+40,w)
w=PutRect(s,x1-20,y2-20,x2-x1+40,40,w)
w=PutRect(s,x2-20,y1-20,40,y2-y1+40,w)
resultis w
]

and PutRect(s,x,y,w,h,wc) = valof [

let t=table [ ESetX lshift 8; ESetY; 0; (ENop lshift 8)+ERect; 0; 0 ]
t>>RCT.xl=x rshift 8
t>>RCT.xr=xŹ
t>>RCT.y=y
t>>RCT.w=w
t>>RCT.h=h
WriteBlock(s, t, RCTlen)
resultis wc+RCTlen
]

and FixPartDir(pw,s) be [

let opv=OutPartDirPtr
Zero(opv, PDlen)// zero any unset bits
opv>>PD.type=0
opv>>PD.pstart=NextPartRec(opv)
opv>>PD.precs=FilePage(s)-opv>>PD.pstart
opv>>PD.padding=pw
OutPartDirPtr=OutPartDirPtr+PDlen
]

// 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
// copies DL

and SetupEntityList(pdv,evec,os,ddv) = valof [

if pdv>>PD.precs eq 0 then resultis 0// empty page
let startrec=pdv>>PD.pstart// set offset
if startrec ge ddv>>DD.nrecs then Error("bad page address")
let trecs = pdv>>PD.precs & #177600// nearest 200
let w=((pdv>>PD.precs & #177) lshift 8) - pdv>>PD.padding-1
let ec=0
[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=l
ec=ec+1
if ec ge MaxEntities then Error("too many entities")
w=w-l
]eloop repeat
PositionPage(InputStream, startrec+1)
CopyPages(os, trecs)// copy pages of DL
CopyPages(os,w rshift 8)// copy more pages of DL
CopyWords(os,(wŹ)+1)// rest of DL, zero word
resultis ec
]

and CopyPages(os,np) be [

let pagebuffersize=(FixedLeft()-1000)/256// no of pages
if pagebuffersize le 0 then Error("no room to copy pages")
let pagebuffer=GetFixed(pagebuffersize lshift 8)
let i=0
until i ge np do [
let pc=min(pagebuffersize,np-i)
let wc=pc lshift 8
ReadBlock(InputStream,pagebuffer,wc)
WriteBlock(os,pagebuffer,wc)
i=i+pc
]
FreeFixed(pagebuffer)
]

and CopyWords(os,nw) be [

for i=1 to nw do Puts(os, Gets(InputStream))
]

and PGread(pn,wn) = valof [

PositionPage(InputStream,pn+(wn rshift 8)+1)
PositionPtr(InputStream, (wnŹ)*2)
resultis Gets(InputStream)
]

and FindPart(pn,ddv) = valof [

let count=0
for i=0 to ddv>>DD.nparts-1 do [
let p=PageDir+i*PDlen
if p>>PD.type eq 0 then [
if count eq pn then resultis p
count=count+1
]
]
resultis 0
]

and WriteFontDir(os) = valof [

let fev=vec FElen-1
let nw=0// word count
for i=0 to MaxSet do [
let fp=FontSets+16*i
unless BlankSet(fp) then for j=0 to 15 do [
let p=fp!j
if p ne 0 then [
Zero(fev, FElen)
fev>>FE.length=FElen
fev>>FE.set=i
fev>>FE.fno=j
fev>>FE.destn=255
let famp=FamilyDir+FamilyLen*
p>>FONT.family
MoveBlock(lv fev>>FE.fam, famp, FamilyLen)
fev>>FE.face=p>>FONT.face
fev>>FE.siz=p>>FONT.ptsize
fev>>FE.rotn=p>>FONT.rotn

WriteBlock(os, fev, FElen)
nw=nw+FElen
]
]
]
Puts(os, 0)
nw=nw+1
resultis AddPart(1,PadOut(os,nw))
]

and PadOut(os,wds) = valof [
until (wds & #377) eq 0 do [
Puts(os, 0)
wds=wds+1
]
resultis wds
]


and WritePartDir(os) be [

let nw=OutPartDirPtr-OutPartDir
OutDocDir>>DDV.nparts=nw/PDlen
if (nwŹ) ne 0 then nw=(nw𫓸)+256
WriteBlock(os, OutPartDir, nw)
OutDocDir>>DDV.pdrecs=nw rshift 8
let pds=NextPartRec(OutPartDirPtr)
OutDocDir>>DDV.pdstart=pds
OutDocDir>>DDV.nrecs=pds+(nw rshift 8)+1
]

and WriteDocDir(os,ofn) be [

OutDocDir>>DDV.passwd=PressPassword
ReadCalendar(lv OutDocDir>>DDV.date1)// insert date
let tvec = vec lenUTV-1
UNPACKDT(lv OutDocDir>>DDV.date1, tvec)// unpack date, time
let timestring = vec 15
CONVUDT(timestring, tvec, true)// print zone
Zero(OutDocDir+#200, #200)
MoveBlock(OutDocDir+#200,ofn,StringWords(ofn))
MoveBlock(OutDocDir+#232,UserName,StringWords(UserName))
MoveBlock(OutDocDir+#252,timestring,StringWords(timestring))
WriteBlock(os, OutDocDir, 256)
]

and StringWords(s) = (nth(s,0) rshift 1) + 1

and NextPartRec(opv) = (opv eq OutPartDir ? 0, (opv-PDlen)>>PD.pstart +
(opv-PDlen)>>PD.precs)