// IfsPressRare.bcpl -- Routines for utilizing printer specific capabilities
// Copyright Xerox Corporation 1980, 1981
// Last modified November 21, 1981  12:30 PM by Taft

get "IfsPress.decl"
get "Pup0.decl"
get "Pup1.decl"
get "Streams.d"

external
[
// outgoing procedures
GetPrinterCapabilities; GenPrintInstance;

// incoming procedures
Block; Dequeue; Dismiss; SetTimer; TimerHasExpired; StringCompare;
Allocate; FreePointer; MoveBlock; Zero;
Endofs; Gets; Puts; Stateofs; PutTemplate; Wss;
OpenLevel1Socket; CloseLevel1Socket; CompletePup; GetPBI; ReleasePBI;

// incoming statics
sysZone;
]

//--------------------------------------------------------------------------
structure [ bytes↑1,1 byte ]
//--------------------------------------------------------------------------

manifest
[
maxPropItemChars = 127
maxPropItemWords = maxPropItemChars rshift 1 +1
QuoteChar = $'
]



//--------------------------------------------------------------------------
let GenPrintInstance(buf, pqe) = valof
//--------------------------------------------------------------------------
[
Zero(buf, 256); buf!0, buf!1 = PrInstPass0,PrInstPass1
let s = vec lST; InitPListStream(s, buf+2, 508)
Puts(s, $( )
if pqe>>PQE.holdPassword ne 0 then
 WriteStringProp(s, "HOLD", pqe + pqe>>PQE.holdPassword)
if pqe>>PQE.duplex then WriteStringProp(s, "DUPLEX", "TRUE")
resultis Puts(s, $) ) + 4 //stream position + password overhead
]

//--------------------------------------------------------------------------
and GetPrinterCapabilities(port, pqe) = valof
//--------------------------------------------------------------------------
[
// This attempts to adjust the pqe as to the printer's capabilities.
// Since this is only possible with Spruce11 servers, the task is
// complicated.  We will try for 30 seconds to get a "Spooling and
// waiting" response...(this is the only state in which the server
// will respond to a capability request.)  If we get one, then we
// will try to get the printer's capabilities.  The server will be
// deemed to be down if it is busy or not available.  If no status
// response is returned then we can't judge the server to be down
// since non-Spruce servers don't return status.

let status = nil;
let timer = nil;
let statusPort = vec lenPort;
MoveBlock(statusPort, port, lenPort)
statusPort>>Port.socket↑1 = 0
statusPort>>Port.socket↑2 = socketPrinterStatus

let soc = vec lenPupSoc
OpenLevel1Socket(soc, 0, statusPort, true);  // transient
SetTimer(lv timer, 100*busyTimeout)      // 30 sec
   [  // Repeat
   status = psNotResponding;
   let pbi = TryForReply(soc,typePrinterStatusRequest,typePrinterStatusReply)
   if pbi ne 0 then
      [ status = pbi>>PBI.pup.words↑1; ReleasePBI(pbi); ]
   if status eq psNotSpooling then break;
   // Printer won't give capabilities if it's printing so...
   if status ne psSpoolingAndWaiting then [ Dismiss(500); loop; ]

   pbi = TryForReply(soc, typePrCapabilityRequest, typePrCapabilityReply)
   if pbi ne 0 then 
      if ScanPListPBI(pbi, pqe) then [ status = psGotCapabilities; break; ]
   ] repeatuntil TimerHasExpired(lv timer)
CloseLevel1Socket(soc)
resultis status;
]

//--------------------------------------------------------------------------
and TryForReply(soc, type, replyType) = valof
//--------------------------------------------------------------------------
[
for i = 1 to 5 do
   [
   CompletePup(GetPBI(soc), type, pupOvBytes)
   let timer = nil; SetTimer(lv timer, 20)
      [
      Block();
      let pbi = Dequeue(lv soc>>PupSoc.iQ)
      if pbi ne 0 then
         [
         if pbi>>PBI.pup.type eq replyType resultis pbi
         ReleasePBI(pbi)
         ]
      ] repeatuntil TimerHasExpired(lv timer)
   ]
resultis 0
]

// Maybe someday this will all go away.  It would be nicer to use the same
//  PList stuff as the FTP package.  But for now:

//--------------------------------------------------------------------------
and ScanPListPBI(pbi, pqe) = valof
//--------------------------------------------------------------------------
//Expects to find a pList as the next thing in stream.
//Scans the pList, calling routine(name,value,param) for each item, which
// should return true to continue scanning and false to abort.
//Returns true if all goes well.
//Returns false if the list had bad syntax.
[
let ok = false;
let stream = vec lST;
InitPListStream(stream, lv pbi>>PBI.pup.bytes, pbi>>PBI.pup.length-pupOvBytes)

let char = IgnoreBlanks(stream)
if char eq $( then
   [
   let name = Allocate(sysZone,maxPropItemWords)
   let value = Allocate(sysZone,maxPropItemWords)
   ok = valof
      [
      switchon IgnoreBlanks(stream) into
         [
         case $): resultis true
         case $(: break
         default: resultis false
         ] repeat
      unless GetPListItem(stream, name, $*S) resultis false
      unless GetPListItem(stream, value, $)) resultis false
      let boolean = StringCompare(value, "TRUE") eq 0;

      // Horrible..horrible:
      if StringCompare(name, "DUPLEX") eq 0 then
       unless boolean do pqe>>PQE.duplex = false;
      if StringCompare(name, "PRINT-INSTANCE") eq 0 then
       unless boolean do pqe>>PQE.spruce11 = false;
      ///////
      ] repeat
   FreePointer(lv name, lv value)
   ]
ReleasePBI(pbi);
resultis ok
]

//--------------------------------------------------------------------------
and GetPListItem(stream, lvDest, termChar) = valof
//--------------------------------------------------------------------------
//Reads stream assembling a string at lvDest.
//Unquotes characters. Returns true if all is well.
//Terminates when it reads termChar.
[
let length = 0
let quotePending = false
let char = IgnoreBlanks(stream)
until char eq termChar & not quotePending do
   [
   if char eq -1 then resultis false
   quotePending = char eq QuoteChar & not quotePending
   unless quotePending do
      [
      if length eq maxPropItemChars resultis false
      length = length + 1
      lvDest>>String.char↑length = char
      ]
   char = Gets(stream)
   ]
lvDest>>String.length = length;
resultis true
]

//--------------------------------------------------------------------------
and IgnoreBlanks(stream) = valof
//--------------------------------------------------------------------------
[
if Endofs(stream) resultis -1
let char = Gets(stream)
if char ne $*S resultis char
] repeat

//--------------------------------------------------------------------------
and WriteStringProp(stream,name,string) be
//--------------------------------------------------------------------------
[
let QuotedWss(stream,string) be
   for i = 1 to string>>String.length do
      [
      let char = string>>String.char↑i
      if char eq $) % char eq $( % char eq QuoteChar then
         Puts(stream,QuoteChar)
      Puts(stream,char)
      ]
PutTemplate(stream,"($S $P)",name,QuotedWss,string)
]

//--------------------------------------------------------------------------
and InitPListStream(s, buf, len) = valof
//--------------------------------------------------------------------------
[
Zero(s, lST)
s>>ST.par1 = buf
s>>ST.par2 = 0
s>>ST.par3 = len
s>>ST.gets = PrinterPListGetsPuts
s>>ST.puts = PrinterPListGetsPuts
s>>ST.endof = PrinterPListEndofs
]

//--------------------------------------------------------------------------
and PrinterPListGetsPuts(s, char; numargs na) = valof
//--------------------------------------------------------------------------
[
if Endofs(s) resultis -1
let buf = s>>ST.par1
let bytePos = s>>ST.par2 + 1
s>>ST.par2 = bytePos;
if na ls 2 then resultis buf>>bytes↑(bytePos)
buf>>bytes↑(bytePos) = char; resultis bytePos;
]

//--------------------------------------------------------------------------
and PrinterPListEndofs(s) = s>>ST.par2 ge s>>ST.par3
//--------------------------------------------------------------------------