// quitcom.sr


get "char.df";
get "bravo1.df";
get "measure.df"
get "vm.df"
// get "doc.df"	definitions below
get "altofilesys.d"
get "st.df"
get "dir.df"
get "com.df"
get "rn1.df"
get "param.df"
get "display.df"
// get "select.df"	definition (ulmode1) below

// Incoming Procedures

external	[
	stappend
	FcFindLabel
	FcGetParam
	tsflush
	FtyOpen
	slget
	slput
	owritemacro
	setreplay
	array
	endofs
	gets
	puts
	flushfn
	trims
	ult
	getvch
	bravochar
	measureq
	uc
	SetRegionW
	SetRegionSys
	updatedisplay
	selectwholeww
	invalidatesel
	underline
	updateunderline
	blinkscreen
	flushvm
	];


// Incoming Statics

external	[
	mpWwWwd
	mpfnof
	vformattedfile
	fpRemCm
	fnts
	tsmacro
	vphp1
	vcp
	vmapstatus
	vdoc
	macww
	rgmaccp
	tsread
	quitchar
	vmeasurestatus
	vdcborig
	vdcbsys
	vrlwsys
	selmain
	dcpendofdoc
	];


// Outgoing Procedures

external	[
	omacro2;
	quitcom;
	];


// Outgoing statics

// external


// Local statics

// static


// Local structures

structure SW:
	[
	ANYCOMCM	bit 1;
	ANYREMCM	bit 1;
	blank		bit 14
	] 


// Local manifest

manifest	[ 
	doctx0 = 0
	uloff = 0
	ulmode1 = 2
	swloc = #1002;
	maxbuf = 1000;
	tyQuit = 0
	tyMacro = 1
	tyError = 2

	abComTerm = 2 lshift (16 - offset AB.crid - size AB.crid) +
		0 lshift (16 - offset AB.nrid - size AB.nrid)
	abUnknown = 2 lshift (16 - offset AB.crid - size AB.crid) +
		2 lshift (16 - offset AB.nrid - size AB.nrid)
	abBlank = 1 lshift (16 - offset AB.crid - size AB.crid) +
		4 lshift (16 - offset AB.nrid - size AB.nrid)
	] 


// O Q U I T P A R A M
//
let oquitparam(char) = valof
[
let i = nil;
let comstream = 0;
let userstream = 0;
let quittime = false;
let pos = nil;
test char gr 0 ifso
	[ let sbuserquit = vec 20;
	rv sbuserquit = 1 lshift 8 + char;
	stappend(sbuserquit, ".QUIT");
//	if mpfnof ! fnuser eq -1 then
//		resultis tyError;
	(mpfnof ! fnuser) >> OF.pos = 0;
	let prm = vec lprmovh+144; prm >> PRM.cchMax = 288
	let fcFirst = FcFindLabel(sbuserquit, prm, fnuser, 0, "BRAVO")
	if prm >> PRM.pt eq ptNil then
		resultis tyError;
	FcGetParam(fnuser, fcFirst, prm, false)
	let sl = lv prm >> PRM.astr
	tsflush();
	vformattedfile = false;
	FtyOpen(fnrem, "REM.CM", true, false, vcNewestOrNew, fpRemCm);
	vformattedfile = true;
	if slget(sl, 1) eq $q then
		if slget(sl, 2) eq chcr then
			[ quittime = true;
			for i = 3 to rv sl do
				slput(sl, i-3, slget(sl, i));
			rv sl = (rv sl)-3;
			] 
	fnts = fnrem;
	unless owritemacro(fnts, sl, omacro2) do
		resultis tyError;
	unless quittime do
		[
		(mpfnof ! fnts) >> OF.pos = 0;
		tsmacro = true;
		setreplay();
		resultis tyMacro;
		] 
	] 
ifnot	[ vphp1 = array(maxbuf);
	i = 0;
	until endofs(fnts) do
		[ vphp1 ! i = gets(fnts);
		i = i+1;
		] 
	(mpfnof ! fnts) >> OF.pos = 0;
	(mpfnof ! fnts) >> OF.macpos = 0;
	for j = 0 to i-1 do
		puts(fnts, vphp1 ! j);
	flushfn(fnts);
	] 

(mpfnof ! fnts) >> OF.macpos = (mpfnof ! fnts) >> OF.pos;
trims(fnts);
if (mpfnof ! fnts) >> OF.pos then swloc >> SW.ANYREMCM = 1;
resultis tyQuit;
] 

// O M A C R O 2
//
and omacro2(fn, n) be
[ 
let message= "##window##"
let cwwg= 0
let ww= 0
let maccp= nil
vcp = 0;
vmapstatus = statusblind;
test n le 3 
	ifso 	[
		vdoc = doctx0+n;
		maccp = rgmaccp!vdoc
		]
	ifnot	[
		until (cwwg eq n-3) % (ww eq macww - 1) do
			[
			ww=ww+1
			if ww eq (mpWwWwd!ww)>>WWD.wwgroup then
			 cwwg= cwwg+1
			]
		vdoc = (mpWwWwd!ww)>>WWD.doc
		maccp= rgmaccp!vdoc - dcpendofdoc
		unless cwwg eq n-3 then
			[ for i= 0 to message>>SB.cch-1 do
				puts(fn, message>>SB.ch↑i)
			return
			]
		]
while ult(vcp, maccp) do
	puts(fn, getvch());
] 


// Q U I T C O M
//
and quitcom(cf) = valof
[
// SetRegionSys(risysstate, 74)
// SetRegionSys(risyspast, rinil)
// updatedisplay()

let trid0, trid1 = nil, nil
let lastchar = -1;
let ofscr = nil
	[ let tchar = bravochar();
	let ww = nil
	switchon tchar into
		[ 
case chdel:
		resultis abComTerm

case chcr:
		ww = 1
		while ww ls macww & not (tsread & tsmacro) do
			[
			let wwgroup = (mpWwWwd ! ww)>>WWD.wwgroup
			if (mpWwWwd ! (wwgroup+1))>>WWD.fDirty then
				[
				underline(uloff, selmain)
				selectwholeww(selmain, wwgroup+1)
				invalidatesel(selmain)
				underline(ulmode1, selmain)
				updateunderline()
				SetRegionSys(risyspast, 216)
				SetRegionSys(risysstate, 217)
				updatedisplay()
				let fFirstLoop = true
					[
					let ch = uc(bravochar())
					if ch eq chdel then
						resultis abComTerm
					if ch eq $Y then break
					if fFirstLoop then blinkscreen()
					fFirstLoop = false
					] repeat
				]

				[
				ww = ww + 1
				if ww ge macww then break
				if (mpWwWwd ! ww)>>WWD.wwgroup ne wwgroup then break
				] repeat
			]

		if (lastchar ge 0 % (tsmacro & tsread)) then
			[
			let ty = oquitparam(lastchar)
			if ty ne tyQuit then
				[
				quitchar = lastchar
				resultis (ty eq tyError ? abUnknown, abBlank)
				]
			]
		if vmeasurestatus<<MEASURESTATUS.q then
			measureq()
//
//
//
//
//
// 		unless swloc>>SW.ANYREMCM do
// 			[
// 			(mpfnof ! fnts)>>OF.macpos = (mpfnof ! fnts)>>OF.pos + 2
// 			trims(fnts)
// 			]
		rv vdcborig = vdcbsys
		flushvm();
		resultis abQuit

default:
		tchar = uc(tchar)
		test tchar eq bs ifso
			[
			lastchar = -1
			trid0 = rinil
			]
		ifnot
			[
			lastchar = tchar
			let asb = 1 lshift 8 + tchar
			SetRegionW(vrlwsys, 0, lv asb)
			trid0<<RID.nrl = 1
			trid0<<RID.ri = 0
			]
		SetRegionSys(risyspast, trid0)
		updatedisplay()
		loop
		]
	] repeat
]