// Bcpl EmPressInit.bcpl - EMbark text files to PRESS format

//last modified:
// Brian Badenoch February 4, 1981 add resetSwatee global, increase nameVec
get "PupEFTP.decl"
get "AltoFileSys.d"
get "PressFile.d"
get "Streams.d"

external
[
//outgoing procedures
SearchUserCm; FreeSpaceToSysZone; GetParameters; SetUpFileNames

//incoming procedures from Empress
GetDateAndTime; GetPrinterStatus; FinishUp

//incoming procedures from OS
OpenFile; ReadBlock; FilePos
Endofs; Gets; Closes; Puts; Resets
Ws; Wss; CallSwat; MoveBlock; Zero; MyFrame
InitializeZone; AddToZone; Allocate; Free; ReadCalendar

//incoming procedures from packages
SetupReadParam; ReadParam; ReadParamStream
PutTemplate; ReadUserCmItem
ExtractSubstring; CreateStringStream; StringCompare; ConcatenateStrings
InitializeContext; CallContextList; Block; Dismiss
OpenLevel1Socket; CloseLevel1Socket; InitPupLevel1
GetPBI; ReleasePBI; CompletePup; GetPartner
InitEFTPPackage

//incoming statics
breakPageName; printedBy; headerDate
widthTab; leading; pointSize; fontName; numCopies
numInputNames; currentInputName; maxInputNames
inputNames; inputDVs; pressFile; merging; heading; forceDate
addresseeName; keyString; docName; titleString;
weight; slope; expansion;
printerName; localFilename; transmitFlag; waitFlag
ctxQ; printerPort; statusStream
usingSwatee; resetSwatee; addresseesFinished
password; forName; duplex; forceDuplex

//incoming statics from OS
keys; dsp; sysZone; UserPassword

//incoming statics from Empress1
headerName

]

compiletest alto
ifso
[
external
[
//incoming procedures
LookupEntries; CONVUDT
CreateDisplayStream; ShowDisplayStream
TruncateDiskStream; PositionPage
LoadRam; InitBcplRuntime

//incoming statics
fpSysDir; fpUserCm; UserName
RamImage
]
]
ifnot
[
external
[
InitNovaAlto
]
]

manifest
[
stackLimit = #335
socketPrinterServer = #20
psNotSpooling = 1
]

//----------------------------------------------------
structure String: [ length byte; char↑1,1 byte ]
//----------------------------------------------------

//----------------------------------------------------
let TextToInt(string,defaultVal) = valof
//----------------------------------------------------
[
let val = 0
for i = 1 to string>>String.length do
[
let char = string>>String.char↑i
unless (char ge $0) & (char le $9) do
[
PutTemplate(dsp,"*N$S is not an integer. Value used is $UD",
string,defaultVal)
resultis defaultVal
]
val = val*10 + (char-$0)
]
resultis val
]

//----------------------------------------------------
and ScanForChar(st, i ,char) = valof
//----------------------------------------------------
[
// scan string st, starting at character i, for st!i
//char ge 0, EQ
//char ls 0, NE
// return updated i, if found
// -1 if not
// the first character of st is st!1

let j = st>>String.length
test char ge 0 ifso
while i le j do
[
if st>>String.char↑i eq char resultis i
i = i+1
]
ifnot
while i le j do
[
if st>>String.char↑i ne -char resultis i
i = i+1
]
resultis -1
]

//----------------------------------------------------
and FreeSpaceToSysZone() be
//----------------------------------------------------
[
let freeBegin,freeEnd = nil,nil
compiletest alto
ifso //alto stack
[
freeBegin = @stackLimit
freeEnd = MyFrame()-100
@stackLimit = freeEnd
]
ifnot //nova stack
[
freeBegin = MyFrame()+100
freeEnd = @stackLimit
@stackLimit = freeBegin
]
let freeSpace = freeEnd-freeBegin
test freeSpace ls 0
ifnot sysZone = InitializeZone(freeBegin,freeSpace)
ifso
[
sysZone = InitializeZone(freeBegin,#77777)
if freeSpace-#77777 gr 20 then
AddToZone(sysZone,freeBegin+#77777,freeSpace-#77777)
]
]

//----------------------------------------------------
and SearchUserCm() be
//----------------------------------------------------
[
//set up some defaults
let defaultPrintedBy = "$"

//go read user.cm
let userCm = OpenFile("USER.CM",ksTypeReadOnly,charItem,0,(alto? fpUserCm,0))
if userCm ne 0 then
[
let string = vec 127
let type = ReadUserCmItem(userCm,string)
if type eq $N & StringCompare(string,"HARDCOPY") eq 0 then
[
type = ReadUserCmItem(userCm,string)
if type eq $E % type eq $N break
let lvDest = 0
if type eq $L then
[
if StringCompare(string,"PRESS") eq 0 then
lvDest = lv printerName
if StringCompare(string,"PRINTEDBY") eq 0 then
lvDest = lv defaultPrintedBy
if StringCompare(string,"FONT") eq 0 then //$$$$$
[
type = ReadUserCmItem(userCm,string)
if type eq $E break
if (type eq $S % type eq $P) then
[
let s = 1
let t = ScanForChar(string,s,$ )
test t ge 0 ifso
[
fontName = ExtractSubstring(string,1,t-1)
s = ScanForChar(string,t,-$ )
t = ScanForChar(string,s,$ )
let p =ExtractSubstring (string, s, t ls 0?string>>String.length,t-1)
pointSize = TextToInt(p,pointSize)
Free(sysZone,p)
s = ScanForChar(string,t,-$ )
if s gr 0 then
[
weight=string>>String.char↑s
s = ScanForChar(string,s+1,-$ )
if s gr 0 then
[
slope=string>>String.char↑s
s = ScanForChar(string,s+1,-$ )
if s gr 0
then expansion = string>>String.char↑s
]
]
]
ifnot
[
fontName = ExtractSubstring(string)
]
]
loop
]//$$$$$
]
if lvDest ne 0 then
[
type = ReadUserCmItem(userCm,string)
if type eq $E break
if (type eq $S % type eq $P) then
//$$$$$
@lvDest = ExtractSubstring(string)
]
] repeat
if type eq $E break
] repeat
Closes(userCm)

printedBy = Allocate(sysZone,127)
let ss = CreateStringStream(printedBy,255)
for i = 1 to defaultPrintedBy>>String.length do
test defaultPrintedBy>>String.char↑i eq $$
ifso Wss(ss,(alto? UserName, "Nova"))
ifnot Puts(ss,defaultPrintedBy>>String.char↑i)
Closes(ss)
]

//----------------------------------------------------
and GetParameters() be
//----------------------------------------------------
[
//set up defaults for user-settable parameters
widthTab = 8
numCopies = 1
pointSize = 8
fontName = "GACHA"
addresseeName = 0
keyString = "<---------------------------------------->"
titleString = "<--title-->"
docName = 0
weight = $M
slope = $R
expansion = $R
duplex = false
waitFlag = false
forName = 0
password = 0
resetSwatee = false

SearchUserCm() //printerName and printedBy

inputNames = Allocate(sysZone,maxInputNames)
inputDVs = Allocate(sysZone,maxInputNames*lDV)
localFilename = 0 //onto which press conversion is done

let nameVec, switchVec = vec 40, vec 10
SetupReadParam(nameVec,switchVec)

//global switches
let notFlag = false
heading = true
for i = 1 to switchVec!0 do
[
switchon switchVec!i into
[
case $-:
[ notFlag = not notFlag; loop ]
case $H: case $h:
[ heading = not notFlag; endcase ]
case $D: case $d:
[ forceDate = not notFlag; endcase ]
case $M: case $m:
[ merging = not notFlag; endcase ]
case $R: case $r:
[ resetSwatee = not notFlag; endcase ]
case $S: case $s:
[ password = UserPassword; endcase ]
case $T: case $t:
[ transmitFlag = not notFlag; endcase ]
case $W: case $w:
[ waitFlag = not notFlag; endcase ]
case $2:
[ duplex = not notFlag; forceDuplex = true; endcase ]
]
notFlag = false
]

//parameters
until ReadParam($P,0,nameVec,switchVec,true) eq -1 do
[
//no switch defaults to input file name
if switchVec!0 eq 0 then switchVec!1 = $i
switchon switchVec!1 into
[
case $a: case $A: //addressee name
[
addresseeName = ExtractSubstring(nameVec)
endcase
]
case $c: case $C: //number of copies
[
numCopies = TextToInt(nameVec,numCopies)
endcase
]
case $d: case $D: //Document name
[
docName = ExtractSubstring(nameVec)
endcase
]
case $f: case $F: //font name
[
fontName = ExtractSubstring(nameVec)
endcase
]
case $h: case $H: //host name
[
printerName = ExtractSubstring(nameVec)
endcase
]
case $0: case $1: case $2: case $3: case $4:
case $5: case $6: case $7: case $8: case $9:
[
let val = switchVec!1 - $0
for i = 2 to switchVec!0 do val = val*10 + switchVec!i-$0
widthTab = val
//falls through
]
case $i: case $I: //input file
[
if numInputNames eq maxInputNames then
[
PutTemplate(dsp,"*NToo many names: only first $UD files used",
maxInputNames)
endcase
]
inputNames!numInputNames = ExtractSubstring(nameVec)
numInputNames = numInputNames +1
endcase
]
case $k: case $K: //Key string
[
keyString = ExtractSubstring(nameVec)
endcase
]
case $n: case $N: //Name (printed for)
[
forName = ExtractSubstring(nameVec)
endcase
]
case $o: case $O: //output file name
[
localFilename = ExtractSubstring(nameVec)
endcase
]
case $p: case $P: //point size
[
pointSize = TextToInt(nameVec,pointSize)
endcase
]
case $s: case $S: //Secret (password)
[
password = ExtractSubstring(nameVec)
endcase
]
case $t: case $T: //tab width
[
widthTab = TextToInt(nameVec,widthTab)
endcase
]
default:
[
PutTemplate(dsp,"*NIgnoring $S/$C.",nameVec,switchVec!1)
endcase
]
]
]
if printerName eq 0 & transmitFlag then
[
ReadParam($P,"*NPrinter host name: ",nameVec)
printerName = ExtractSubstring(nameVec)
]
Closes(ReadParamStream)
]

//----------------------------------------------------
and SetUpFileNames() be
//----------------------------------------------------
[
if localFilename eq 0 & not transmitFlag then
[
let lastDot = (inputNames!0)>>String.length
for i = (inputNames!0)>>String.length to 1 by -1 do
if (inputNames!0)>>String.char↑i eq $. then
[ lastDot = i-1; break ]
let nameBody = ExtractSubstring(inputNames!0,1,lastDot)
localFilename = ConcatenateStrings(nameBody,".Press",true,false)
]

PutTemplate(dsp,"*NFont:$S$UD, tab width:$UD, copies:$UD",
fontName,pointSize,widthTab,numCopies)
headerDate = GetDateAndTime(transmitFlag)

if transmitFlag then
[
InitPupLevel1(sysZone,ctxQ,10)
printerPort = Allocate(sysZone,lenPort)
PutTemplate(dsp,", host:$S ",printerName)
unless GetPartner(printerName,dsp,printerPort,0,socketPrinterServer) finish
compiletest alto
ifnot [ statusStream = dsp ]
ifso
[
statusStream = CreateDisplayStream(4,Allocate(sysZone,2000),2000)
ShowDisplayStream(statusStream)
]
if GetPrinterStatus(statusStream) eq psNotSpooling then FinishUp()
InitEFTPPackage()
]

if numInputNames eq 0 then
[
Ws("*NNo input file names supplied")
FinishUp()
]

compileif alto then
[
let sysDir = OpenFile("SysDir",0,0,0,fpSysDir)
if sysDir eq 0 then CallSwat("Cant open SysDir!")
LookupEntries(sysDir,inputNames,inputDVs,numInputNames,true)
Closes(sysDir)
]

test localFilename eq 0
ifso
[
usingSwatee = true
localFilename = alto? "Swatee", "TEMP.PRESS"
breakPageName = inputNames!0 //first source file name
]
ifnot
[
usingSwatee = false
breakPageName = localFilename
]

addresseesFinished = (addresseeName eq 0)
]