// measure.sr
get "MEASURE.DF";
get "BRAVO1.DF";
get "CHAR.DF";
get "VM.DF"
get "DOC.DF"
get "SELECT.DF"
// Incoming Procedures
external [
ReadCalendar
UNPACKDT
outnum
puts
ult
getvch
closes
outsb
mpfnof;
pctb;
rgpctb;
mppccp;
mpfnsb;
];
// Incoming Statics
external [
vlt
cpscrt
quitchar
ccommand
vcpagehc
rgmaccp
vdoc
vcp
vmapstatus
UserName
errhlta
movec;
];
// Outgoing Procedures
external[
measureq;
measurep;
];
// Outgoing Statics
external [
vbttoti;
vbttotd;
vtodstart;
];
// Local Statics
static [
vbttoti;
vbttotd;
vtodstart;
];
// M E A S U R E P
//
// let measurep(doc, fn, sbfilenam, oldfn) be
let measurep(doc, fn, sbfilenam) be
[
// let oldmacpos = (oldfn eq -1) ? 0, (mpfnof ! oldfn) >> OF.macpos;
let macpos = (mpfnof ! fn) >> OF.macpos;
let mpfnccp = vec maxfn;
movec(mpfnccp, mpfnccp+maxfn-1, 0);
pctb = rgpctb ! doc;
let pcd = pctb+pctb >> PCTB.rgpcd;
mppccp = lv (pctb >> PCTB.rvmppccp);
for pc = 0 to pctb >> PCTB.macpc-1 do
[ unless pcd >> PCD.live then
[ let tfn = (pcd >> PCD.vpa) << VPA.fn;
let tccp = (mppccp ! (pc+1))-mppccp ! pc;
mpfnccp ! tfn = mpfnccp ! tfn+tccp;
]
pcd = pcd+4;
]
let dyt = vec lndyt;
UNPACKDT(0, dyt);
putheader(fnmeasure, dyt, $P, true);
outsb(fnmeasure, sbfilenam);
puts(fnmeasure, chsp);
outnum(fnmeasure, macpos);
puts(fnmeasure, chsp);
// outnum(fnmeasure, macpos-oldmacpos, 10, 0, false, true, true);
// puts(fnmeasure, chsp);
puts(fnmeasure, $**);
puts(fnmeasure, chsp);
outnum(fnmeasure, mpfnccp ! fnscr);
puts(fnmeasure, chsp);
puts(fnmeasure, $();
for tfn = minuserfn to maxfn-1 do
[
// if (mpfnccp ! tfn eq 0) % (tfn eq oldfn) then loop;
if (mpfnccp ! tfn eq 0) then loop;
if mpfnsb ! tfn eq 0 then errhlta(205);
outsb(fnmeasure, mpfnsb ! tfn);
puts(fnmeasure, chsp);
outnum(fnmeasure, mpfnccp ! tfn);
puts(fnmeasure, chsp);
]
puts(fnmeasure, $));
puts(fnmeasure, chcr);
]
// M E A S U R E Q
and measureq() be
[
let tod = vec 2;
ReadCalendar(tod);
let dytcur = vec lndyt;
UNPACKDT(tod, dytcur);
putheader(fnmeasure, dytcur, $Q, true);
outnum(fnmeasure, tod ! 1-vtodstart ! 1);
puts(fnmeasure, chsp);
outnum(fnmeasure, cpscrt);
puts(fnmeasure, chsp);
outbt(fnmeasure, vbttoti);
puts(fnmeasure, chsp);
outbt(fnmeasure, vbttotd);
puts(fnmeasure, chsp);
test quitchar ne 0 ifso
puts(fnmeasure, quitchar)
ifnotputs(fnmeasure, $**);
puts(fnmeasure, chsp);
outnum(fnmeasure, ccommand);
puts(fnmeasure, chsp);
outnum(fnmeasure, vcpagehc);
puts(fnmeasure, chsp);
let cSec = ((vlt>>LT.cCyc)/60)+((vlt>>LT.cMin)*60);
outnum(fnmeasure, cSec);
puts(fnmeasure, chsp);
puts(fnmeasure, $**);
puts(fnmeasure, chsp);
let maccp = rgmaccp ! docremark;
vdoc = docremark;
vcp = 0;
vmapstatus = statusblind;
while ult(vcp, maccp) do
[
let tchar = getvch();
puts(fnmeasure, tchar eq chcr ? chsp, tchar);
]
puts(fnmeasure, chcr);
closes(fnmeasure);
]
// P U T H E A D E R
and putheader(fn, dyt, type, fuser) be
[
outnum(fn, dyt >> DYT.year-1900, 10, 2, true, false);
outnum(fn, dyt >> DYT.month+1, 10, 2, true, false);
outnum(fn, dyt >> DYT.day, 10, 2, true, false);
puts(fn, chsp);
outnum(fn, dyt >> DYT.hour, 10, 2, true, false);
outnum(fn, dyt >> DYT.minute, 10, 2, true, false);
outnum(fn, dyt >> DYT.second, 10, 2, true, false);
puts(fn, chsp);
outsb(fnmeasure, "BRAVO ");
puts(fn, type);
puts(fn, chsp);
if fuser then
[
outsb(fn, UserName);
puts(fn, chsp);
]
]
// O U T B T
and outbt(fn, bt) be
[
test bt ! 0 ne 0 ifso
[
outnum(fn, bt ! 0);
outnum(fn, bt ! 1, 10, 4, true, false);
]
ifnotoutnum(fn, bt ! 1);
]