// Bcpl PrinterPList.bcpl
// Property list routines for Printer status
//Extracted and modified from FtpPListProt
//last modified:
//Rick Tiberi July 27, 1979 3:07 PM
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 ]
//----------------------------------------------------
//----------------------------------------------------
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
// ---------------------------------------------