// 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)
		or	Wss(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) 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.
// Since pDoc may be reclaimed between time of call to Post(), and call
// to SpruceUser(), save pDoc in string form.
//	Queue the created structure on messageQ, for timely handling by SpruceUser(), above.
	[
	unless messageQ do messageQ = FSGetX(2, SpruceZone, 0)
	if pDoc then
		[
		if str>>STR.length gr 0 then CallSwat("Post: Called with String & pDoc params")
		let str = FSGetX(64, SpruceZone, 0)
		let strStream = CreateStringStream(str, 64, 0, SpruceZone)
		PrintDocInfo(pDoc, 0, strStream)
		StringCloses(strStream)
		]
	let len = str>>STR.length/2+1
	let message = FSGetX(minLenPOstedMsg+len, SpruceZone)
	message>>POstedMsg.pDoc = 0
	message>>POstedMsg.condition = condition
	MoveBlock(lv message>>POstedMsg.str, 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)
    PostState()
// CleanupQ probably not necessary
    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)
    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 ----*N	Started $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.
	[
	if na ls 5 then onStream = 0
	let isSubFile = file>>SPruceFile.isSubFile
	PutTemplate((onStream ne 0 ? 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
	// we should never end up here whilst writing onStream
	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
// ------------------------------------------------------
	[
	if na ls 3 then onStream = 0
	let h = pDoc>>DocG.FileHost
	PutTemplate((onStream ne 0 ? onStream, dsp),
		"*NHost $2O#$3O#, $S ", h rshift 8, h&#377,
		 pDoc>>DocG.needsPassword? "PROTECTED", 
		 pDoc>>DocG.available? "Available", pDoc>>DocG.printed? "Printed",
		 pDoc>>DocG.inProgress? "In Progress","Pending")
	let f = pDoc>>DocG.PressFile
	test f eq -1 then PutTemplate(dsp,"Printer Command $D*N", pDoc>>DocG.printerDirective)
	 or if f then PrintFile(lvPause, lv pDoc>>DocG.CreatStr, lv pDoc>>DocG.FileStr, f, onStream)
	]

// ------------------------------------------------------
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.(635)\676b45B215b10B4092b38B3102b118B147b260B76b12B29b1B618b35B3678b22B231b74B13b31B95b12B26b5B3b12B46b33B37b56B244b22B66b30B42b31B411b10B2471b8B4b12B37b8B