//  look3.sr


get "BRAVO1.DF";
get "ST.DF";
get "CHAR.DF";
get "MSG.DF";
get "NEWMSG.DF";
get "SELECT.DF";
get "COM.DF";
get "DISPLAY.DF";
get "LOOK.DF";
get "DOC.DF";
get "PARSE.DF";


// Incoming procedures

external	[
	move;
	select;
	bravochar;
	underline;
	updateunderline;
	inserttx;
	endofkeystream;
	setbug;
	cpparabounds;
	invalidatesel;
	FFillInUfop;
	stnum;
	stcopy;
	stappend;
	updatedisplay;
	formaty;
	SetRegionSys;
	RoundRatio
	FGetTxpParam
	MakeCurrentBuf
	stput
	stget
	AbReadLookEscSeq
	WriteLookEscSeq
	augmentomseq
	deactivateomseq
	movec
	errhlta
	deleted
	insertc
	InsertBuf
	stsize
	]

// Incoming statics

external	[
	putbacks;
	selarg;
	mpIffFfp;
	mpWwWwd;
	vww;
	rgmaccp;
	vcpatxdl
	tsread
	]

// Outgoing procedures

external	[
	AbGetArg
	]

// Outgoing statics

// external

// Local statics

// static


// Local manifests

manifest	[
	pidPfop = 0
	pidArd = 1
	pidFMicas = 2
	pidAb = 3
	pidDoc = 4
	pidCp = 5

	pidPwFirst = 6
	pidPwLast = 7
	pidFSwappedIn = 8
	]


// A B   G E T   A R G

let AbGetArg(pfop, ard) = valof
[
let fMicas = ard>>ARD.fMicas ne 0
let ab = abTyping
let doc = 0
let cp = 0
let pwFirst = pfop + ard>>ARD.iwFirst;
let pwLast = pfop + ard>>ARD.iwLast;
let fSwappedIn = false;

// pid manifests for all the above guys !!

SetRegionSys(risysstate, 133, ard>>ARD.ri, 134)
MakeCurrentBuf(1)
updatedisplay()

let pfopDefault = vec lnufopMax
move(pfop, pfopDefault, lnufopMax)
putbacks = false

	[
	test tsread ifso
		[
		ab = AbReadLookEscSeq(pwFirst, pwLast)
		FopToBuf(pfop, ard, ab)
		]
	ifnot	[
		selarg>>SEL.type = snone
		select(selarg, 0, FSelectContinue, FSelectProc)
		WriteLookEscSeq(ab, pwFirst, pwLast)
		]
	let ch = bravochar()
	if ch eq $\ then
		[
		unless ard>>ARD.fDefault do
			resultis abNoDefault
		ab = abDefault
		underline(uloff, selarg)
		updateunderline()
		move(pfopDefault, pfop, lnufopMax)
		FopToBuf(pfop, ard, ab)
		loop
		]
	if ch eq chdel then
		resultis abComTerm
	if ch ne chesc then
		[
		unless ard>>ARD.fTyping do
			resultis abIllParam
		unless inserttx(1, wwsys, ch) do
			resultis abComTerm
		ab = abTyping
		]
	break
	] repeat
if ab eq abTyping then
	[
	let arg = nil
	let fIncrement = nil
	unless FParseBuf(lv arg, lv fIncrement, buf1, fMicas) do
		resultis abIllParam
	movec(pwFirst, pwLast, arg)
	pfop>>UFOP.fIncrement = fIncrement
	FopToBuf(pfop, ard, ab)
	]
if fSwappedIn then
	deactivateomseq("\", "\");
resultis ab
]


// F   S E L E C T   C O N T I N U E

and FSelectContinue(sel, fm) = valof
[
unless endofkeystream() do resultis false
unless (fm ! pidArd)>>ARD.fWhere do resultis true
if ((rv bug) & 2) ne 0 then resultis true
if fm ! pidAb ne abWhere then
	[
	underline(uloff, sel)
	updateunderline()
	setbug(snone)
	sel>>SEL.type = snone
	fm ! pidAb = abWhere
	rv (fm ! pidPwFirst) = -1
	]
let arg = (fm ! pidFMicas) ? xatox(rv xbugloc, rv ybugloc), 0
if arg ne rv (fm ! pidPwFirst) then
	[
	movec(fm ! pidPwFirst, fm ! pidPwLast, arg)
	FopToBuf(fm ! pidPfop, fm ! pidArd, fm ! pidAb);
	]
resultis true
]


// F   S E L E C T   P R O C

and FSelectProc(sel, fm) = valof
[
let cpFirst = sel>>SEL.cpfirst
let cpLast = nil
let type  = nil
let ab = nil
let pfop = fm ! pidPfop
let doc = sel>>SEL.doc

switchon sel>>SEL.type into
	[
case schar:
case sline:
	unless (fm ! pidArd)>>ARD.fHere do resultis false
	cpLast = cpFirst
	type = schar
	ab = abHere
	endcase

case sword:
	cpFirst = vcpatxdl
case sph:
	unless (fm ! pidArd)>>ARD.fSameAs do resultis false
	test (mpIffFfp ! (pfop>>UFOP.iff))<<FFP.fParop ifso
		[
		cpparabounds(doc, cpFirst, lv cpFirst, 0, lv cpLast)
		type = sph
		]
	ifnot	[
		cpLast = cpFirst
		type = schar
		]
	ab = abSameAs
	endcase

default:
	resultis false
	]

if (ab eq fm ! pidAb) & (doc eq fm ! pidDoc) & (cpFirst eq fm ! pidCp) then
	resultis false

test ab eq abHere ifso
	[
	let arg = sel>>SEL.xdfirst lshift 5
	movec(fm ! pidPwFirst, fm ! pidPwLast, arg)
	FopToBuf(pfop, fm ! pidArd, ab)
	]
ifnot	[
	unless fm ! pidFSwappedIn do
		[
		augmentomseq("\");
		fm ! pidFSwappedIn = true;
		];
	unless FFillInUfop(pfop, doc, cpFirst) do
		resultis false
	FopToBuf(pfop, fm ! pidArd, ab)
	]

sel>>SEL.cpfirst = cpFirst
sel>>SEL.cplast = cpLast
sel>>SEL.type = type
invalidatesel(sel)
fm ! pidDoc = doc
fm ! pidCp = cpFirst
fm ! pidAb = ab
resultis true
]


// F   P A R S E   B U F

and FParseBuf(parg, pfIncrement, buf, fMicas) = valof
[
let txp = vec lntxp
txp>>TXP.doc = doctx0 + buf
txp>>TXP.cp = 0
txp>>TXP.cpMac = rgmaccp ! (doctx0+buf)
augmentomseq("*140")
let fResult = FGetTxpParam(parg, pfIncrement, txp, fMicas, true)
deactivateomseq("*140", "*140")
resultis fResult
]


// F O P   T O   B U F

and FopToBuf(pfop, ard, ab) be
[
let sbPt = sbnil;
let sbIn = sbnil;
let tsbPt = vec 10;
let tsbIn = vec 10;

let iff = pfop>>UFOP.iff;
if iff ge iffMax then errhlta(208);
switchon iff into
	[
case iffProcXtb:
	if pfop ! 1 eq xtbNil then
		[
		sbPt = "(not set)";
		sbIn = sbPt;
		];
	endcase;

case iffProcLeftmarg:
	if pfop ! 1 ne pfop ! 2 then
		[
		let tsb1 = vec 15;
		sbPt = tsb1;
		let tsb2 = vec 15;
		sbIn = tsb2;
		stcopy(sbPt, "F:");
		stcopy(sbIn, sbPt);
		SbPtSbIn(tsbPt, tsbIn, pfop ! 2, false, true);
		stappend(sbPt, tsbPt);
		stappend(sbIn, tsbIn);
		stappend(sbPt, " P:");
		stappend(sbIn, " P:");
		SbPtSbIn(tsbPt, tsbIn, pfop ! 1, false, true);
		stappend(sbPt, tsbPt);
		stappend(sbIn, tsbIn);
		];
	endcase;

case iffProcYpos:
	if pfop ! 1 eq -1 then
		[
		sbPt = "(no V. tab)";
		sbIn = sbPt;
		];
	endcase;

// case iffProcTable:
//	if ab eq abSameAs then
//		[
//		sbPt = "(all tabs)";
//		sbIn = sbPt;
//		];
//	endcase;

default:
	endcase;
	]

if sbPt eq sbnil then
	[
	SbPtSbIn(tsbPt, tsbIn, pfop ! (ard>>ARD.iwFirst),
	  pfop>>UFOP.fIncrement, ard>>ARD.fMicas);
	sbPt = tsbPt;
	sbIn = tsbIn;
	];

SbToBuf(sbPt, buf1);
SbToBuf(sbIn, buf2);
updatedisplay();

] // end FopToBuf


// S B   P T   S B   I N

and SbPtSbIn(sbPt, sbIn, arg, fSigned, fMicas) be
[
test fSigned ifso
	[
	let sbSign = nil
	test arg ls 0 ifso
		[
		arg = -arg
		sbSign = "-"
		]
	ifnot	sbSign = "+"
	stcopy(sbPt, sbSign)
	stcopy(sbIn, sbSign)
	]
ifnot	[
	sbPt ! 0 = 0
	sbIn ! 0 = 0
	]
let tsb = vec 5
let argpts = fMicas ? RoundRatio(arg, 18, 635), arg
stnum(tsb, argpts, 10, 0, false, false, false)
stappend(sbPt, tsb)
stappend(sbPt, "pt")
let arginches = RoundRatio(argpts, 100, 72)
stnum(tsb, arginches, 10, (arginches ls 100 ? 3, 0), true, false, false)
let tcp = tsb>>SB.cch
stput(tsb, tcp, stget(tsb, tcp-1))
stput(tsb, tcp-1, stget(tsb, tcp-2))
stput(tsb, tcp-2, $.)
tsb>>SB.cch = tcp + 1
stappend(sbIn, tsb)
stappend(sbIn, "in")
]


// S B   T O   B U F

and SbToBuf(sb, buf) be
[
let doctx = doctx0+buf
deleted(doctx)
insertc(doctx, 0, sb)
InsertBuf(buf, doctx, 0, stsize(sb))
]


// X A T O X

and xatox(xa, y) = valof
[
formaty(y);
let wwd = mpWwWwd ! vww
let xd = xa-xaudleft+wwd>>WWD.xdUd;
resultis xd lshift 5;
]