// 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)
ifnot	puts(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);
	] 
ifnot	outnum(fn, bt ! 1);
]

z20602(1270)