//PrinterPlist.Sr - last modified:  July 27, 1979  


// Bcpl PrinterPList.bcpl - Property list routines for Printer status
//Extracted and modified from FtpPListProt
get "Time.d"
get "Streams.d"

external
[
//outgoing procedures
ScanPList; InitPListStream
WriteStringProp; WriteDateProp; WriteNumberProp
WriteKeywordProp; WriteBooleanProp
Nin; WriteDT; ParseDate
//incoming procedures
Puts; Gets; Endofs; Wss; Zero; Allocate; Free
ExtractSubstring; PutTemplate; MoveBlock
MyFrame; CoReturn; GotoFrame; MulPlus32x16
PACKDT; UNPACKDT; WRITEUDT; FINDMONTH
//incoming statics
sysZone
]

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

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

//----------------------------------------------------
structure Time [ h word; l word ]
//----------------------------------------------------

//----------------------------------------------------
structure [ bytes^1,1 byte ]
//----------------------------------------------------
//procedures
//----------------------------------------------------
let ScanPList(stream, routine,param) = 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 char = IgnoreBlanks(stream)
if char ne $( then
   [
   resultis false
   ]
let name = Allocate(sysZone,maxPropItemWords)
let value = Allocate(sysZone,maxPropItemWords)
let 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
   unless routine(name, value, param) resultis false
   ] repeat
Free(sysZone, name)
Free(sysZone, value)
resultis ok
]
//----------------------------------------------------
and IgnoreBlanks(stream) = valof
//----------------------------------------------------
[
if Endofs(stream) resultis -1
let char = Gets(stream)
if char ne $*S resultis char
] repeat
//----------------------------------------------------
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.
[
lvDest>>String.length = 0
let quotePending = false
let char = IgnoreBlanks(stream)
   [
   if char eq -1 resultis false
   if char eq termChar & not quotePending resultis true
   if char ne QuoteChar % quotePending then
      [
      if lvDest>>String.length eq maxPropItemChars resultis false
      lvDest>>String.length = lvDest>>String.length + 1
      lvDest>>String.char^(lvDest>>String.length) = char
      ]
   quotePending = char eq QuoteChar & not quotePending
   char = Gets(stream)
   ] repeat
]
//----------------------------------------------------
let 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 WriteDateProp(stream,name,lvDate) be
//----------------------------------------------------
[
if lvDate>>Time.h ne 0 then
   PutTemplate(stream,"($S $P)",name,WriteDT,lvDate)
]
//----------------------------------------------------
and WriteNumberProp(stream,name,number,double;numargs N) be
//----------------------------------------------------
[ if N ls 4 then double = false
test double  //true if double precision
   ifnot PutTemplate(stream,"($S $UD)",name,number)
   ifso PutTemplate(stream,"($S $EUD)",name,number)
]
//----------------------------------------------------
and WriteBooleanProp(stream,name,boolean) be
//----------------------------------------------------
[
PutTemplate(stream,"($S $S)",name,(boolean?"TRUE","FALSE"))
]
//----------------------------------------------------
and WriteKeywordProp(stream,name) be
//----------------------------------------------------
[
PutTemplate(stream,"($S)",name)
]
//----------------------------------------------------
and ParseDate(string,lvRes) = valof
//----------------------------------------------------
//parses the string format date in string into an Alto
//format date which it puts in the two word vector at lvRes.
//returns true if successful, false if not.
//"day-month-year hour:minute:second"
[
let uv = vec lenUTV; Zero(uv,lenUTV)
let frame = InterpretDate(uv)
for i = 1 to string>>String.length do
   GotoFrame(frame,string>>String.char^i)
GotoFrame(frame,0)  //flush out the last token
resultis PACKDT(uv,lvRes) eq 0
]
//----------------------------------------------------
and InterpretDate(uv) be
//----------------------------------------------------
   [
   let token = 1
   manifest maxChars = 19
   let temp = vec (maxChars rshift 1)
   let AlphaNumeric(char) = (char ge $0 & char le $9) %
    (char ge $A & char le $Z) % (char ge $a & char le $z)
      [
      temp!0 = 0
      let char = CoReturn(MyFrame())
      test AlphaNumeric(char)
         ifnot loop  //ignore punctuation separating tokens
         ifso
            [
            let length = temp>>String.length
            if length ls maxChars then
               [
               temp>>String.length = length+1
               temp>>String.char^(length+1) = char
               ]
            char = CoReturn()
            if AlphaNumeric(char) loop
            switchon token into
               [
               case 1: [ Nin(temp,lv uv>>UTV.day); break ]
               case 2: [ uv>>UTV.month = FINDMONTH(temp); break ]
               case 3:
                  [
                  Nin(temp,lv uv>>UTV.year)
                  uv>>UTV.year = uv>>UTV.year+1900
                  break
                  ]
               case 4: [ Nin(temp,lv uv>>UTV.hour); break ]
               case 5: [ Nin(temp,lv uv>>UTV.minute); break ]
               case 6: [ Nin(temp,lv uv>>UTV.second); break ]
               default: break
               ]
            ] repeat
      token = token+1
      ] repeat
   ]
//----------------------------------------------------
and WriteDT(stream,dt) be
//----------------------------------------------------
   [
   let uv = vec 7
   if dt!0 ne 0 then
      [
      UNPACKDT(dt,uv)
      WRITEUDT(stream,uv)
      ]
   ]
//----------------------------------------------------
and Nin(string,lvDest,double; numargs na) = valof
//----------------------------------------------------
[
if na ls 3 then double = false
let start = 1
for i = 1 to string>>String.length do
   if string>>String.char^i ne $*S then
      [ start = i; break ]
let number = vec 1; Zero(number,2)
for i = start to string>>String.length do
   [
   let char = string>>String.char^i
   if char ls $0 % char gr $9 then resultis false
   MulPlus32x16(char-$0,10,number)
   ]
test double
   ifnot lvDest!0 = number!1
   ifso MoveBlock(lvDest,number,2)
resultis true
]
and
// ---------------------------------------------
let InitPListStream(s, buf, len) = valof
// ---------------------------------------------
[
Zero(s, lST)
s>>ST.par1 = buf
s>>ST.par2 = 0
s>>ST.par3 = len
s>>ST.gets = PListGets
s>>ST.puts = PListPuts
s>>ST.endof = PListEndofs
s>>ST.stateof = PListStateofs
]
and
// ---------------------------------------------
let PListGets(s) = valof
// ---------------------------------------------
[ if Endofs(s) resultis -1
s>>ST.par2 = s>>ST.par2 + 1
resultis (s>>ST.par1)>>bytes^(s>>ST.par2)
]
and
// ---------------------------------------------
let PListPuts(s, char) = valof
// ---------------------------------------------
[ if Endofs(s) resultis -1
s>>ST.par2 = s>>ST.par2 + 1
let buf = s>>ST.par1
buf>>bytes^(s>>ST.par2) = char
]
and
// ---------------------------------------------
let PListEndofs(s) = s>>ST.par2 ge s>>ST.par3
// ---------------------------------------------
and
// ---------------------------------------------
let PListStateofs(s) = s>>ST.par2
// ---------------------------------------------