// SpruceUser.Bcpl
get "sprucedoc.d"
get "sprucemisc.d"
get "spruceinldoutld.d"
get "spruceprinters.d"
get "sprucefiles.d"
// get "PressFile.d"
get "Altofilesys.d"

// outgoing procedures
external [
InitUser
GetAChar
Post
CheckQ
PostState
]
// incoming procedures
external [
// OS
Gets; Endofs; Puts
MoveBlock; Zero
CallSwat; EraseBits; CharWidth
ReadCalendar
// Contexts
Block
InitializeContext
// SpruceFiles
ForgetSpruceFile
// Spruce Utilities
ForEach; FSGetX; FSPut; Max; Min
RpageToVpage
VpageToRpage
Ugt
Wss
// ErrorMessage
FindErrorMessage
// SpruceQueue
CleanupQueue; MarkQueueEntry
// Queues
Enqueue; Dequeue; QueueLength
// Template
PutTemplate
// Strings
CreateStringStream
StringCloses
// Ctime
UNPACKDT; WRITEUDT
// SpruceML
MulDiv
]
// incoming statics
external [
BinCounters
NumBins
messageQ
spooling; printing
keys; dsp
SpruceZone
reasonVec
Debug
freeFile
numFilesSpooled
SproullerQ
SpoolVec
ErrorFile
Version; MinorVersion; SprintVersion; SprintMinorVersion
timeUp; timeRestart
PressServer
pressFileIndex
printerName
printerDevice
xmFonts
Capabilities
firstDCB
stopsPrinting//defined here
]

manifest USERStackSize = 400
static stopsPrinting


// ------- User Interface Context (Process) -------

// ------------------------------------------------------
let SproullUser() be [ let quitting = 0
// ------------------------------------------------------
//Two jobs: print and otherwise manage status and error reports submitted via the Post() function,
// to synchronize display use (includes deleting structures used in the reports, on occasion); and
// implement a rudimentary user interface at the Spruce terminal. See Spruce manual for commands.
//See Post() description for the kinds of posted messages that can be handled.
[
@#420 = firstDCB
if stopsPrinting then printing = false
if messageQ then while @messageQ do
[
let message = Dequeue(messageQ)
let condition = message>>POstedMsg.condition
test condition eq ECStateRequest then PostState()
or [
let pDoc = message>>POstedMsg.pDoc
let mStr = lv message>>POstedMsg.str
let cStr = selecton condition into [ default: 0;
case ECFileTerminate: "Problem with Press file: ";
case ECEngineTerminate: "Problem with Printer: ";
case ECFatal: "Spruce internal error encountered: ";
case ECSpoolTerminate: "File transmission error: " ]
if cStr then PutTemplate(dsp, "$S*N", cStr)
if mStr>>STR.length then PutTemplate(dsp, "$S*N", mStr)
if pDoc then PrintDocInfo(pDoc, 0)
if pDoc&condition eq ECSpoolTerminate then
[ let f = pDoc>>DocG.PressFile; if Ugt(f+1, 1) then ForgetSpruceFile(f); FSPut(pDoc) ]
]
FSPut(message)
Block()
]
let str, vbl, char = nil, nil, GetAChar(true)
if char then [ if char eq $*N&quitting finish; quitting = 0 ]
switchon char into
[
case $B: if (Capabilities&mColor) do
[ Capabilities = Capabilities xor mBlackHousing; vbl = (((Capabilities & mBlackHousing) ne 0)? "Start ", "Stop ")
str = "black housing"; docase -2]; endcase
case $1: if printerDevice eq printerPenguin do
[ Capabilities = Capabilities xor mDuplex; vbl = (((Capabilities & mDuplex) ne 0)? "Start ", "Stop ")
str = "twosided default"; docase -2 ]; endcase
case -2: PutTemplate(dsp,"$S$S*N", vbl, str); endcase
case $P: if stopsPrinting do
[
test (stopsPrinting & #377) eq jam then
PutTemplate(dsp, "$D sheets removed from paper path/Auxtray?[Confirm]*N", stopsPrinting rshift 8)
orWss(dsp, "Output bin cleared?[Confirm]*N")
[ let char = nil; char=GetAChar(true) repeatuntil char; unless char eq $*N endcase ]
if stopsPrinting eq binFull then @BinCounters = 0
stopsPrinting = false
]
vbl = lv printing; str = "printing"; docase -1
case $S: vbl = lv spooling; str = "spooling"; // docase -1
case -1:
PutTemplate(dsp,"$S$S*N", (@vbl? "Stop ", "Start "), str)
@vbl = not @vbl; endcase

// Specify a tray or trays to clear
case $T: Wss(dsp, "*NClear tray: ") ;
[
let char = nil; char=GetAChar(true) repeatuntil char; Puts(dsp, char)
let v = selecton char into
[
case $A: 18
case $B: 17
case $C: 16
case $D: 15
case $E: 14
case $F: 13
case $G: 12
case $H: case $I: 11
case $J: case $K: 10
case $L: 9
case $M: 8
case $N: case $O: 7
case $P: case $Q: 6
case $R: 5
case $S: 4
case $T: case $U: case $V: 3
case $W: 2
case $X: case $Y: case $Z: 1
case $*N: case $0: 20 //clear all bins
case $1: 0 //clear main bin
default: -1
]
if v < 0 do [ Wss(dsp, "INVALID*N"); endcase ]
unless (Capabilities & (mMailbox + mMultiBin)) ne 0 do v = 0//(below) if test satisfied, mark all bins for clearing
test ((v eq 20) % ((Capabilities & mMultiBin) ne 0)) then Zero(BinCounters, NumBins-2)
or BinCounters!v = 0
if (@BinCounters eq 0) & (stopsPrinting eq binFull) then stopsPrinting = false
Wss(dsp, " Cleared*N")
] ; endcase

// Specify a reason for a stop spooling request
// Fix to catch overflow of reasonVec
case $R:
[
PutTemplate(dsp,"Reason: "); reasonVec!0 = 0
let ct = 0
[
unless valof [ char = GetAChar(false); resultis char ] loop
switchon char into
[
case ($A-#100):
[ if ct do
[ char = reasonVec>>STR.char↑ct; EraseBits(dsp, -CharWidth(dsp, char)); ct = ct-1 ];
endcase ]
case ($W-#100):
[ while (ct > 0) & ( char ne $*S) do
[ char = reasonVec>>STR.char↑ct; EraseBits(dsp, -CharWidth(dsp, char)); ct = ct-1 ];

endcase ]
default:
[
Puts(dsp,char)
if char eq #15 break; if char eq #177 then [ ct = 0; Puts(dsp, #15); break ]
ct = ct+1; if ct eq 40*2 break
reasonVec>>STR.char↑ct = char
endcase
]
]
] repeat
reasonVec>>STR.length = ct; endcase
]

// change Penguin output mode
case $2: vbl = 0; str = "Single bin"; docase $x
case $3: vbl = mMailbox; str = "Mailbox"; docase $x
case $4: vbl = mMultiBin; str = "Multibin"; // docase $x
case $x: if printerDevice ne printerPenguin endcase
PutTemplate(dsp, " *N$S output [confirm]:", str)
[ let char = nil; char=GetAChar(true) repeatuntil char; unless char eq $*N endcase ]
Capabilities = (Capabilities & not (mMailbox + mMultiBin)) + vbl
Wss(dsp, "ok*N")
endcase

// change overflow protection mode
case $5: vbl = 0; str = "No"; docase $y
case $6: vbl = mSpruceClear; str = "Job"; docase $y
case $7: vbl = mStopWhenFull; str = "Continuous"; docase $y
case $8: vbl = mStopAfterJob; str = "Stop-after-job"; // docase $y
case $y: PutTemplate(dsp, " *N$S protection mode [confirm]:", str)
[ let char = nil; char=GetAChar(true) repeatuntil char; unless char eq $*N endcase ]
Capabilities = (Capabilities & not (mSpruceClear + mStopWhenFull + mStopAfterJob)) + vbl
Wss(dsp, "ok*N")
endcase
case $D: PutTemplate(dsp, "*NCall SWAT debugger [confirm]")
[ let char = nil; char=GetAChar(true) repeatuntil char;
unless char eq $*N endcase ]
CallSwat("[Debug] Type ctrl-P to proceed"); endcase
case $C: CheckQ(false); endcase
case $V: CheckQ(true); endcase
case $M: ModifyQ()
case 0: endcase
case $Q: PutTemplate(dsp,"*NQuit [confirm]"); quitting = true
]
] repeat ]


// ------- Client-Called Routines -------

// ------------------------------------------------------
and InitUser(ctxQ) be
// ------------------------------------------------------
//Called once from SpruceInit() to start up user context and intialize state.
[
Enqueue(ctxQ, InitializeContext(FSGetX(USERStackSize), USERStackSize, SproullUser))
]

// ------------------------------------------------------
and Post(pDoc, condition, str; numargs na) be
// ------------------------------------------------------
//Create a POstedMsg structure (see Spruce.d). Up to three lines of information can be supplied:
//pDoc: if present, causes printer command or spooled file to be described. File name may be a string
// describing a problem, instead, if spooling was unsuccessful (~~ still needs work.)
//condition: if non-zero, describes a Sprint or Spruce termination condition. Issue a descriptive line.
//str: if present, a string to print on its own line.
//Queue the created structure on messageQ, for timely handling by SpruceUser(), above.
[
unless messageQ do messageQ = FSGetX(2, SpruceZone, 0)
//save pDoc in string form
let fileString = vec 70
if pDoc then
[
let strStream = CreateStringStream(fileString, 139, 0, SpruceZone)
if na eq 3 then PutTemplate(strStream, "$S", str)
PrintDocInfo(pDoc, 0, strStream)
PutTemplate(strStream, " ")
StringCloses(strStream)
]
let len = (pDoc ? fileString, str)>>STR.length/2+1
let message = FSGetX(minLenPOstedMsg+len, SpruceZone)
message>>POstedMsg.pDoc = 0
message>>POstedMsg.condition = condition
MoveBlock(lv message>>POstedMsg.str, (pDoc ? fileString, str), len)
Enqueue(messageQ, message)
]


// ------- Action Routines for SpruceUser() -------

// ------------------------------------------------------
and CheckQ(pause) be
// ------------------------------------------------------
//Prints a description of each queued document, prints global spooler state, then checks for
// discrepancies in the required spooling invariants (see SpruceQueue). See PrintFile() for pause use.
[
Wss(dsp, "*N*N***************N")
ForEach(SproullerQ, PrintDocInfo, lv pause, true)
PostState()
CleanupQueue(0, false) // Validates, posts problems, shuts down if there are any
]

// ------------------------------------------------------
and ModifyQ(pause) be
// ------------------------------------------------------
//See Spruce manual for operation. Allows the status of each spooled document and command to be
// changed. Changing from pending or inProgress to printed aborts the printing operation. Changing
// from printed to pending reschedules it. ~~ Temporary... much better interface and controls are needed.
[
Wss(dsp, "*N*N***************N")
pause=true
ForEach(SproullerQ, ModifyDoc, lv pause, true)
CheckQ(false)
]

// ------------------------------------------------------
and ModifyDoc(doc, lvPause) be
// ------------------------------------------------------
[
PrintDocInfo(doc, lvPause)
let arg = doc>>DocG.protected? STATNeedsPassword, STATPending
switchon @lvPause into
[
case $A: Wss(dsp,"Abort [confirm]"); arg=arg + STATPrinted; docase -1;
case $R: unless arg do [ Wss(dsp, "Reprint [confirm]"); docase -1 ]
[
Wss(dsp, "Enter password to (re)print:")
let char, ct = nil, 0
[
unless valof [ char = GetAChar(true); resultis char] loop
if ((char eq #15) % (char eq #177)) break
ct = ct + 1
if Caps(doc>>DocG.Password↑ct) ne char break
] repeat
if char eq #177 do [ Wss(dsp, "Giving up"); break ]
if ((char eq #15) & (ct eq doc>>DocG.Password↑0)) do [ arg = STATPending; docase -2 ]
Wss(dsp, "Incorrect")
] repeat
endcase
case -1: [ let char = nil; char=GetAChar(true) repeatuntil char;
unless char eq $*N endcase ] ;
case -2: MarkQueueEntry(doc, arg); endcase
default: endcase
]
]
// ~~ end extremely temporary and primitive reprint facility

// ------- User Routine Utilities -------

// ------------------------------------------------------
and PostState() be
// ------------------------------------------------------
//Global spooler, printer, system state and history.
[
let maxPages, numFree = freeFile>>SPruceFile.maxPages, freeFile>>SPruceFile.numPages
let black = ((Capabilities & mColor)ne 0) & ((Capabilities & mBlackHousing) ne 0)
let tsprint = ((Capabilities & mDuplex) ne 0)
let outputMode = Capabilities & (mMailbox + mMultiBin)
let protectionMode = Capabilities & (mStopAfterJob + mStopWhenFull + mSpruceClear)
PutTemplate(dsp,
"*N$S Spruce $S Version $D.$D, Sprint Version $D.$D*N---- $SSpooling and $SPrinting ----*NStarted $P, $D files received*N",
printerName, (PressServer? "Server ",""),
Version, MinorVersion,
SprintVersion, SprintMinorVersion,
(spooling? "", "Not "), (printing? "", "Not "), PTime, timeUp, pressFileIndex)
PutTemplate(dsp, "$S $S $S $S $S overflow protection*N",
(tsprint? "two-sided default -", ""),
(black? "Black housing -", ""),
(xmFonts? "Extended memory -", ""),
((outputMode eq mMailbox)? "Mailbox output -", (outputMode eq mMultiBin)? "Multibin output -", ""),
((protectionMode eq mStopWhenFull)? "Continuous",
(protectionMode eq mStopAfterJob)? "Stop-after-job",
(protectionMode eq mSpruceClear)? "Job", "No"))
if timeRestart then PutTemplate(dsp, "Restarted $P*N",PTime,timeRestart)
PutTemplate(dsp,"$D pages max, $D free, Queue $D% full*N",
maxPages, numFree, MulDiv(maxPages-numFree,100,maxPages) )
PrintFile(0, "", "Free File", freeFile)
]

// ------------------------------------------------------
and PTime(s, timeVec) be
// ------------------------------------------------------
[ let v = vec 10
UNPACKDT(timeVec, v); WRITEUDT(s, v, true) ]

// ------------------------------------------------------
and PrintFile(lvPause, str,str1,file, onStream; numargs na) be
// ------------------------------------------------------
//Function obvious. If @lvPause is true coming in, pause for single-character response after each
// file is presented. If the response is $p, discontinue pausing.
[
let isSubFile = file>>SPruceFile.isSubFile
PutTemplate((na eq 5 ? onStream, dsp),
" $O, $D pp. ($D-$D), [$S]$S*N",
file>>SPruceFile.fileCode, file>>SPruceFile.numPages,
(isSubFile ? file>>SPruceFile.offSet+1, 1),
(isSubFile ? VpageToRpage(file, file>>SPruceFile.numPages),
file>>SPruceFile.numPages),
str, str1 )
unless lvPause return
if @lvPause then Puts(dsp, $>)
let char = nil; char = GetAChar(true) repeatuntil char % (not @lvPause)
if char>0 then @lvPause = char eq $P? 0, char
]

// ------------------------------------------------------
and PrintDocInfo(pDoc, lvPause, onStream; numargs na) be
// ------------------------------------------------------
[
let h = pDoc>>DocG.FileHost
PutTemplate((na eq 3 ? onStream, dsp),
"*NHost $2O#$3O#, $S ", h rshift 8, hŹ,
pDoc>>DocG.needsPassword? "PROTECTED",
pDoc>>DocG.available? "Available", pDoc>>DocG.printed? "Printed",
pDoc>>DocG.inProgress? "In Progress","Pending")
let f = pDoc>>DocG.PressFile
switchon f into
[
case -1:
PutTemplate(dsp,"Printer Command $D*N", pDoc>>DocG.printerDirective)
case 0:
endcase
default:
let lvfName = lv pDoc>>DocG.FileStr
let lvcString = lv pDoc>>DocG.CreatStr
test na eq 3
ifsoPrintFile(lvPause, lvcString, lvfName, f, onStream)
ifnotPrintFile(lvPause, lvcString, lvfName, f)
]
]

// ------------------------------------------------------
and GetAChar(caps; numargs na) = valof
// ------------------------------------------------------
//Returns the first buffered keyboard character, or 0 if none is waiting.
//If caps is present and true, capitalize lower-case results.
[
if na ne 1 then caps = false
if Endofs(keys) then [ Block(); resultis 0 ]
let char = Gets(keys)
if caps then char = Caps(char)
resultis char
]

and Caps(char) = valof
[
if $a le char & char le $z then char = char-($a-$A)
resultis char
]

// ------- History . . .

// DCS, July 19, 1977 2:44 PM, primitive version created
// August 28, 1977 8:13 AM, Sprouller->Spruce
// November 3, 1977 8:37 PM, improve stand-alone control v4.(2,7)
// December 16, 1977 11:30 AM, post code releases DocG structure after spooler error report
// January 23, 1978 8:45 AM, improve state reporting
// March 3, 1978 7:21 AM, V6.0, for OS v14 (new time standard)
// June 7, 1978 9:31 PM, fix "% full" computation
// June 9, 1978 12:22 PM, now reports EFTP failures explicitly (bug)
// August 28, 1978 2:31 PM, decimal output of version number
// August 30, 1978 9:35 AM, patch for ignoring file entry when spool abort
// August 31, 1978 2:58 PM, rework status, etc., display, move check code to SpruceQueue
// September 1, 1978 3:37 PM, fix some bugs
// September 4, 1978 3:14 PM, separate all Post contributions to separate, optional lines
// September 4, 1978 5:53 PM, add M command, R and A subcommands -- ~~ UGH!!!!
// September 14, 1978 5:19 PM, printerName, new version stuff
// September 20, 1978 2:48 PM, document, format
// September 22, 1978 11:06 PM, add restart time to global state printout
// February 22, 1979 4:46 PM, release storage used to post messages!!
// May 23, 1979 1:49 PM add "extended" to screen if in use.
// July 29, 1979 2:21 AM, finish up output mode, protection mode, tsprint, password interfaces
// July 31, 1979 10:52 AM, pare get ~~.d so dictionary isn’t too big
// August 18, 1979 5:38 PM, add jam and auxHasTrash stopsPrinting stuff
// August 28, 1979 12:50 PM, fix and clean
// August 29, 1979 10:27 AM, change bin stuff again
// January 18, 1980 12:53 PM, use mDuplex instead of mTSPrint
// March 3, 1980 1:57 PM, pretty up tray clearing message and respond to backspace and
//Backword in reason Vec
// March 4, 1980 9:41 AM, use static firstDCB to prevent loss of display stream
// September 24, 1982 3:27 PM changed PrintDoc to PrintDocInfo to resolve
// confusion with static printDoc. Bug in SWAT (!!!) would cause mix-up
// between the two.