//STP.bcpl printer for sil files. Creates the PRESS file SIL.PRESS
//C. Thacker modified on August 24, 1977 add option to send to the press printer
//R. Bates modified on February 15, 1978 to print color
//R. Bates modified on March 16, 1978 to put file name in Sil.Press+new time standard
//R. Bates modified on June 16, 1978 added font faces
//R. Bates modified on June 16, 1978 renamed program to SilToPress
get "sysdefs.d"
get "Sil.defs"
external [ PUTB ] //from this file
external MulDiv //from FontWidths.bcpl
manifest
[
//press commands:
SetX = #356
SetY = #357
ShowRectangle = #376
ShowCharacters = #360
Nop = #377
SetFont = #160
]
external
[
UserName
DayTime; UNPACKDT; CONVUDT
dsp
]
static
[
@ncopies
@PressS
@BackGndEn
@DoFnt15 = false
@ScanCvrt = false
@fheight
@fontsel
@EntityBytesSent
@FirstDLByte
@DLBytesSent
@ByteCarry =0
@PartDir
@PDptr
@BytesOut = 0
@CurrentRecord = 0
@Nparts = 0
@FontNames
@FontUsed = 0
@Xmargin = Lmargin
@Ymargin = 0
@C1778 = C1778dflt
@C50 = C50dflt
@prXmin; @prXmax; @prYmin;@prYmax
]
structure FDentry:
[
el word
set byte
font byte
m byte
n byte
fam↑1,20 byte
face byte
source byte
siz word
rotation word
]
let MakePress(PrintSw,InitSwitch,comcm) be
[
Ws("*n*n*n*n*n"); Ws(Herrald)
FontNames = GetSomeMem(100)
InitColorTable(0)
FNameObject = GetSomeMem(140)
let fn = lv FNameObject>>item.string
SilInitCode(InitSwitch,0,FontNames)
let v = vec 50; InitCursor(v,50,0,0)
WriteCursor(Wss,"pg")
//initialize a zone for the file system
let v = vec 2000
SilZone = InitializeZone(v,2000)
//set up the part directory
let v = vec 256
PartDir = v
PDptr = PartDir
Zero(PartDir,256)
//initialize the Macro Definition Table
//Zero(Mact,Mtsize)
//use remaining space for the objects
SpaceBase = @#335 //EndCode
@#335 = lv PrintSw -2000 //set EndCode - leave 2000 words for the stack
SpaceTop = @#335-128 //leave margin for error
if (SpaceTop-SpaceBase-10000) ls 0 then CallSwat("Insufficient Object Storage")
let PressName = vec 100
let PressFile = vec 50; PressFile!0 = 0; AppendS("Sil.Press",PressFile)
let Host = vec 50; Host!0 = 0
OneLevel = false //ask for full macro expansion
PressS = 0
//THE MAIN FILE INPUT LOOP
let Page = 0
[
WriteCursor(Wns,Page+1,2)
WriteCursor($i)
InitStorage()
if not ReadCmEntry(comcm,fn) then break //no more files
CheckColorCmmd(comcm,fn,Host,PressFile)
if not fn>>str.length then break //command line error
FileIn(0)
let InOK = " "
if Message!0 ne InOK!0 then
[ Ws("*n");Ws(Message);Ws(fn);@#420 = Dcb; loop ]
if not PressS then
[
PressS=OpenFile(PressFile,ksTypeWriteOnly,1,verLatestCreate,0,0,SilZone)
if PressS eq 0 then CallSwat("Can’t Open Sil.Press")
MoveBlock(PressName, fn, 100)//save the name of the first file
]
WriteCursor($o)
@#420 = 0 //turn off display again
PressOut(PressS)
Page = Page+1
] repeat
if ncopies ls 1 then ncopies = 1
if ncopies ne 1 then PrintSw = true
if Page gr 1 then AppendS(" etc.",PressName)
WriteCursor(Wss,"dn")
Closes(comcm)
if PressS ne 0 then //send out the parts directories
[
SendFDEntries(PressS)//make Font Descriptors for the fonts used and send to out file
//Output the font directory
//for i = 0 to 255 do PUTW(PressS,FontDir!i)
//add an entry to the part directory for the font directory
PDptr!0 = 1 //type font directory part
PDptr!1 = CurrentRecord
PDptr!2 =1// FDptr ge 255? 2,1 //font directory is one page long
PDptr = PDptr+3
Nparts = Nparts+1
CurrentRecord = CurrentRecord+1
//Output the part directory
for i = 0 to 255 do PUTW(PressS,PartDir!i)
CurrentRecord = CurrentRecord+1
//Output the Document Directory
let dd=PartDir
for i = 0 to 127 do dd!i = -1
Zero(dd+128,128)
dd!0=27183 //password
dd!1=CurrentRecord+1 //total number of records
dd!2=Nparts //total number of parts
dd!3=CurrentRecord-1 // part directory begins here
dd!4=1 //part directory is 1 record long
//dd!5=-1
DayTime(dd+6) //put 1 sec timer into dd!6 and dd!7
dd!8=1 //first page to print
dd!9=1 //last page
//dd!10=-1
//dd!11=-1
dd!12 = ScanCvrt ne 0? ScanCvrt,-1 //Flag to get full software scan conversion
MoveBlock(dd+200b, PressName, 26)//put in the name of the first file
MoveBlock(dd+232b, UserName, UserName!-1)
let v = vec 6 //now get the Date and Time
UNPACKDT(0,v)
CONVUDT(dd+252b,v)
for i = 0 to 255 do PUTW(PressS,dd!i)
Closes(PressS)
]
test (PrintSw eq true) % Host!0 ifso
[ // Now write command on Rem.Cm and preserve old contents.
let remcm = OpenFile("REM.CM",ksTypeReadWrite,1,0,fpRemCm,0,SilZone)
if remcm eq 0 then finish
let nc=0
until Endofs(remcm) do [ SpaceBase!nc=Gets(remcm); nc=nc+1 ]
Resets(remcm)
Wss(remcm,"Empress "); Wss(remcm,PressFile); Wss(remcm," ")
if ncopies ne 1 then [ Wns(remcm,ncopies𒿑); Wss(remcm,"/c ") ]
if Host!0 then [ Wss(remcm,Host) ]
Wss(remcm,"*n")
for i=0 to nc-1 do Puts(remcm, SpaceBase!i)
Closes(remcm)
]
//CounterJunta(SpeakVersion)
ifnot [ Ws("*n"); Ws(PressFile); Ws(" may be sent directly with use of ’Sil/h’") ]
finish
]
and PUTW(stream,wurd) be
[
PUTB(stream,wurd rshift 8)
PUTB(stream,wurd & #377)
]
and PUTB(stream,bite) be
[
Puts(stream,bite)
EntityBytesSent = EntityBytesSent+1
BytesOut = BytesOut+1
if BytesOut eq 0 then ByteCarry = ByteCarry+1
]
and WSSB(stream,string) be
[
for i=1 to string>>str.length do PUTB(stream, string>>str.char↑i)
]
and InitStorage() be
[
NewItem= SpaceBase
FirstItem = 0
Zero(Mact,Mtsize)
]
and PressOut(st) be //takes a stream open for bytes
[
BytesOut = 0; ByteCarry = 0
//initial color conditions for start of press page
InitColorTable(true)
DoFnt15=false
let link = FirstItem
until link eq 0 do //build DL
[
if ((link>>item.font ge 8)&(link>>item.font ls 14)) then
//macro --expand it and output any strings it contains
[
let sfi = FirstItem
FirstItem = 0
let sni = NewItem
Expand(link,0,0)
let tl = FirstItem
until tl eq 0 do
[
if tl>>item.font ls 8 then WSSB(st,lv(tl>>item.string))
if tl>>item.font eq 15 then DoFnt15 = true
tl=tl>>item.link
]
FirstItem = sfi
NewItem = sni
]
if link>>item.font ls 8 then WSSB(st, lv(link>>item.string))
if link>>item.font eq 15 then DoFnt15 = true
link = link>>item.link
]
if (BytesOut & 1) ne 0 then PUTB(st,0) //pad to word boundary
let BytesInDL = BytesOut
if (BytesInDL ls 0)%(ByteCarry ne 0) then
CallSwat("DL too large- type ↑K to exit")
BytesOut = 0; ByteCarry = 0
//now we are sending EL
PUTW(st,0) //send a 0 word
StartEntity()
FirstDLByte = 0
if BackGndEn ne true then DoFnt15 = false//skip backgrounds to print on Dover
//the following loop may be executed once or twice
//if the previous pass through the item lists found no items of font 15
//then only one pass is needed
//if areas are painted some color, then for objects OVER background,
//backgrounds must be output first - hence two passes
[
link = FirstItem //go through again and output entity list
until link eq 0 do
[
let tl = link; link = link>>item.link
let fnt = tl>>item.font
if ((fnt ge 8)&(fnt ls 14)) then //macro
[
let sfi = FirstItem
FirstItem = 0
let sni = NewItem
Expand(tl,0,0)
let xtl = FirstItem
until xtl eq 0 do
[
if (xtl>>item.font eq 15) eq DoFnt15 then MakeEntity(st,tl,xtl)
xtl = xtl>>item.link
]
FirstItem = sfi
NewItem = sni
loop
]
//not a macro
if (tl>>item.font eq 15) eq DoFnt15 then MakeEntity(st,tl,tl)
]
if DoFnt15 eq 0 then break
if not ScanCvrt then ScanCvrt = $s //dont set $s if nPPR/f said "fast print"
DoFnt15 = 0
] repeat
//send the last entity
PumpOutEntity(st)
//pad
let elp = 0 //entity list padding
until ((BytesOut+BytesInDL) & #777) eq 0 do
[
PUTW(st,0)
elp = elp+1
]
//make an entry in the part directory for this page
PDptr!0 = 0 //type printed page
PDptr!1 = CurrentRecord
let rlen = (BytesOut rshift 9)+(BytesInDL rshift 9)+(((BytesOut & #777)+(BytesInDL & #777))rshift 9)+(ByteCarry lshift 7) //from bytes to pages
PDptr!2 = rlen
CurrentRecord = CurrentRecord+rlen
PDptr!3 = elp
PDptr = PDptr+4
Nparts = Nparts+1
]
and StartEntity() be
[
fontsel=0; fheight=AlFaceVec!(fontsel/4)
EntityBytesSent = 0 //don’t count the zero word
DLBytesSent = 0
prXmin=ScreenXmax; prXmax=-1
prYmin=ScreenYmax; prYmax=-1
]
and MakeEntity(st,tl,xtl) be
[
let xfnt = xtl>>item.font
SetEntityColor(st,tl,xtl)
test xfnt ge 14 ifso //rectangle
[
//crop lines at ScreenMax boundaries
if xtl>>item.xmax gr ScreenXmax then xtl>>item.xmax = ScreenXmax
if xtl>>item.ymax gr ScreenYmax then xtl>>item.ymax = ScreenYmax
let w=xtl>>item.xmax - xtl>>item.xmin
let h=xtl>>item.ymax - xtl>>item.ymin
if w ge 0 & h ge 0 then//Guard against unsanitized Sil files
[
PUTB(st,SetX)
PUTW(st,MulDiv(xtl>>item.xmin, C1778, C50) )
PUTB(st,SetY)
PUTW(st,MulDiv(ScreenYmax-xtl>>item.ymax, C1778, C50) )
PUTB(st,ShowRectangle)
PUTW(st,MulDiv(w ,C1778,C50))
PUTW(st,MulDiv(h ,C1778,C50))
]
]
ifnot
[
//the object is a string
xfnt = xtl>>item.fullfont
FontUsed = FontUsed % (1 lshift xfnt)
PUTB(st,SetX)
PUTW(st,MulDiv(xtl>>item.xmin, C1778, C50) )
if xfnt ne fontsel then
[
fontsel = xfnt //external font with bold/italics bits
fheight = AlFaceVec!(fontsel/4)
PUTB(st,SetFont+fontsel)
]
//The following kludge is in to line up Gates and Template font definitions with sil lines on the printers.
let fudge = fheight ge 32? 16,0 //should be Gates32 or Template64
let pressPosn = ScreenYmax-xtl>>item.ymin-fheight
if pressPosn ls 0 then pressPosn = 0
PUTB(st,SetY)
PUTW(st,MulDiv(pressPosn, C1778, C50) + fudge)
PUTB(st,ShowCharacters)
let bcout =xtl>>item.string.length
PUTB(st,bcout)
DLBytesSent = DLBytesSent+bcout
]
if prXmin gr xtl>>item.xmin then prXmin=xtl>>item.xmin
if prXmax ls xtl>>item.xmax then prXmax=xtl>>item.xmax
if prYmin gr xtl>>item.ymin then prYmin=xtl>>item.ymin
if prYmax ls xtl>>item.ymax then prYmax=xtl>>item.ymax
if EntityBytesSent gr 20000 then PumpOutEntity(st)
]
and PumpOutEntity (st) be
[
if (BytesOut & 1) ne 0 then PUTB(st,Nop) //pad to word boundary
//send entity trailer
PUTB(st,0) //type
PUTB(st,0) //font set
PUTW(st,0); PUTW(st,FirstDLByte) //begin-byte
PUTW(st,0); PUTW(st,DLBytesSent) //byte-length
PUTW(st,MulDiv(Xmargin,C1778,C50)) //Xe
PUTW(st,MulDiv(-Ymargin,C1778,C50)) //Ye
PUTW(st,MulDiv(prXmin,C1778,C50)) //left
PUTW(st,MulDiv(ScreenYmax-prYmax,C1778,C50)) //bottom
PUTW(st,MulDiv(prXmax-prXmin ,C1778,C50)) //width
PUTW(st,MulDiv(prYmax-prYmin ,C1778,C50)) //height
PUTW(st,1+EntityBytesSent/2) //entity length
FirstDLByte = FirstDLByte+DLBytesSent
StartEntity()
]
and SendFDEntries(S) be
[
let FontDir = vec 256
let FDptr = FontDir
Zero(FontDir,256)
if FontUsed eq -1 then CallSwat("To many font & faces in file")
for font = 0 to 3 do
[
let name = FontNames + 25*font
if name>>str.length eq 0 then loop
let ssi = 1 //remove leading "X" in name if there
if ((name>>str.char↑1 eq $X) % (name>>str.char↑1 eq $x)) then ssi=2
let siz = GetNum(name,0)
if siz eq 0 then CallSwat("No point size in font:",name)
let face = 0; let gotsize = false; let sei = 1
for chrptr = 1 to name>>str.length do
[
let lastchar = name>>str.char↑chrptr
if gotsize then switchon lastchar into
[
case $I: case $i: face = face%1; endcase
case $R: case $r:
case $M: case $m: endcase
case $B: case $b: face = face%2; endcase
case $L: case $l: face = face%4; endcase
case $0: case $1: case $2: case $3: case $4:
case $5: case $6: case $7: case $8: case $9: endcase
default: CallSwat("Malformed Font Name:",name)
]
if (lastchar ge $0) & (lastchar le$9) then if gotsize eq false do
[ sei = chrptr-1; gotsize = true ]
]
//fill in the font directory entry for this font
for f = 0 to 3 do
[
let ff = font*4 + f
let fontBit = 1 lshift ff
if (FontUsed & fontBit) ne 0 then
[
FontUsed = FontUsed & not fontBit //flag bit as sent
FDptr>>FDentry.el = 16
FDptr>>FDentry.set = 0
FDptr>>FDentry.font = ff
FDptr>>FDentry.m = 0
FDptr>>FDentry.n = 127
FDptr>>FDentry.fam↑1 = sei-ssi+1 //string length
let i = 2
for j = ssi to sei do
[
FDptr>>FDentry.fam↑i = name>>str.char↑j
i = i+1
]
FDptr>>FDentry.face = f xor face
FDptr>>FDentry.source = 0
FDptr>>FDentry.siz = MulDiv(siz, C50dflt, C50 )
FDptr= FDptr+16
]
]
]
if FontUsed ne 0 then CallSwat("couldn’t find all your fonts in user.cm")
for i = 0 to 255 do PUTW(S,FontDir!i)
]