//  look5.sr
// last modified
// RML add . for color, as opposed to color Tabs: September 21, 1977  4:42 PM
// PCL  make color compatible with Sil:	 December 18, 1979  10:03 AM

get "BRAVO1.DF";
get "CHAR.DF";
get "MSG.DF";
get "NEWMSG.DF";
get "SELECT.DF";
get "COM.DF";
get "LOOK.DF";


// Incoming procedures

external	[
	SetRegionSys
	updatedisplay
	uc
	bravochar
	select
	mapcp
	SiPut
	move
	]

// Incoming statics

external	[
	selarg
	vmapstatus
	vlook1
	vlook2
	parsacred
	ttblsacred
	vofsetstd
	vldlnstd
	vldhdrstd
	vdxtbStd
	vfDiablomode
	]

// Outgoing procedures

external	[
	FopLookAux
	]

// Outgoing statics

// external


// Local statics

// static


// Local manifests

// manifest


// F O P   L O O K   A U X

let FopLookAux(pab, pfop, pard, ch) = valof
[
let fop = nil;

	[
	fop = selecton ch into
		[
case $.:		valof	[
			SetRegionSys(risysstate, 242)	// "Type color..."
			updatedisplay()

		// Eventually this must be more sophisticated
			let tc = colorInterpret(uc(bravochar()))
			unless tc ge 0 do
				[
				rv pab = abIllParam
				resultis fopNil
				]
			resultis iffTc lshift 8 + tc;
			]


case $,:		valof	[
			SetRegionSys(risysstate, 189)	// "Type color..." for Tabs
			updatedisplay()
			let tch = uc(bravochar())
			let tc = nil
			test tch ge $0 & tch le $9 ifso
				tc = tch - $0
			ifnot test tch ge $A & tch le $F ifso
				tc = tch - $A + 10
			ifnot	[
				rv pab = abIllParam
				resultis fopNil
				]
			resultis iffTc lshift 8 + tc;
			]

case $A:
case $S:		valof	[
			SetRegionSys(risyscom, 131)
			SetRegionSys(risysstate, 132)
			updatedisplay();
			selarg>>SEL.type = snone
			select(selarg, 0);
			if bravochar() ne chesc then
				resultis fopNil;
			if selarg>>SEL.type eq snone then
				resultis fopNil;
			vmapstatus = statusblind;
			mapcp(selarg>>SEL.doc, selarg>>SEL.cpfirst, true);
			if ch eq $S then
				[
				pfop ! 1 = vlook1
				pfop ! 2 = vlook2
				resultis iffProcSameLooks lshift 8
				]
			unless parsacred>>PAR.fOldtab do
				parsacred>>PAR.siTtbl = SiPut(siNil, ttblsacred)
			let tpl = vec parovhd+1
			tpl>>PL.cw = parovhd+1
			move(parsacred, tpl+1, parovhd)
			pfop ! 1 = SiPut(siNil, tpl)
			resultis iffProcSamePar lshift 8
			]

case $U:	valof	[
//			if sel>>SEL.type eq sph then
//				resultis fopNil
			pfop ! 1 = vofsetstd
			rv pard = table
				[ 135 lshift 8 + 1 lshift 4 + 1;
				ardStdY;
				]
 			resultis iffSuper lshift 8
			]

case $D:	valof	[
//			if sel>>SEL.type eq sph then
//				resultis fopNil
			pfop ! 1 = vofsetstd
			rv pard = table
				[ 135 lshift 8 + 1 lshift 4 + 1;
				ardStdY;
				]
			resultis iffProcSub lshift 8
			]

case $Z:	valof	[
			pfop ! 1 = -1
			rv pard = table
				[ 182 lshift 8 + 1 lshift 4 + 1;
				ardStdY;
				]
			resultis iffProcYpos lshift 8
			]

case $K:	valof	[
			pfop ! 1 = 0
			rv pard = table
				[ 183 lshift 8 + 1 lshift 4 + 1;
				ardStdY;
				]
			resultis iffYkeep lshift 8
			]

case $X:	valof	[
			pfop ! 1 = vldlnstd
			rv pard = table
				[ 139 lshift 8 + 1 lshift 4 + 1;
				ardStdY;
				]
			resultis iffLdln lshift 8
			]

// case $E:
case $Y:	valof	[
			pfop ! 1 = vldhdrstd
			rv pard = table
				[ 140 lshift 8 + 1 lshift 4 + 1;
				ardStdY;
				]
			resultis iffLdhdr lshift 8
			]

case chtab:	valof	[
			SetRegionSys(risysstate, 144)
			updatedisplay()
			let tch = uc(bravochar())
			let tc = nil
			test tch ge chitbMin & tch ls chitbMin+itbMax ifso
				tc = tch - chitbMin + 1
			ifnot test tch ge $1 & tch le $9 ifso
				tc = tch - $0
			ifnot test tch ge $A & tch le $F ifso
				tc = tch - $A + 10
			ifnot test tch eq $= ifso
				[
				pfop ! 1 = vdxtbStd
				rv pard = table
					[ 141 lshift 8 + 1 lshift 4 + 1;
					ardStdX;
					]
				resultis iffProcDxtb lshift 8
				]
			ifnot	[
				rv pab = abIllParam
				resultis fopNil
				]
			pfop ! 1 = xtbNil
			rv pard = table
				[ 142 lshift 8 + 1 lshift 4 + 1;
				ardStdX;
				]
			resultis iffProcXtb lshift 8 + tc - 1
			]

// case $\:	valof	[
//			let ho = vec lnho
//			augmentomseq("a*140")
//			vmapstatus = statusblind
//			mapcp(doc, 0, parneeded)
//			test parsacred>>PAR.control ifso
//				if CpParseDocProf(ho, doc, 0) eq cpnil then
//					pfop = 0
//			ifnot	DefaultHo(ho)
//			deactivateomseq("a*140", "a*140")
//			if pfop ne 0 then
//				[
//				let xwEdgemarg = ho>>HO.xwEdgemarg
//				let ccol = ho>>HO.ccol
//				let tmod = nil
//				let xwCol = divmod(xwPage -
//					xwEdgemarg lshift 1 -
//					mult(ccol-1, ho>>HO.xwMiddlemarg),
//					ccol, lv tmod)
//				pfop ! 1 = xwCol + xwEdgemarg
//				pfop ! 2 = xwEdgemarg
//				sel>>SEL.cpfirst = 0
//				sel>>SEL.cplast = rgmaccp ! doc - dcpendofdoc - 1
//				]
//			resultis iffProcColumn lshift 8
//			]

// case $|:	valof	[
//			fUndo = true
//			resultis iffProcColumn lshift 8
//			]

// case $T:	valof	[
// 			vmapstatus = statusblind
// 			mapcp(doc, sel>>SEL.cpfirst, parneeded)
// 
// 			pfop ! 1 = parsacred>>PAR.xleftmarg
// 			let tard = table
// 				[ 145 lshift 8 + 1 lshift 4 + 1;
// 				ardStdX;
// 				]
// 			let tab = AbGetArg(pfop, tard)
// 			if tab gr 0 then
// 				[
// 				ab = tab
// 				resultis fopNil
// 				]
// 			if tab eq abSameAs then
// 				[
// 				unless parsacred>>PAR.fOldtab do
// 					pfop ! 1 = SiPut(siNil, ttblsacred)
// 				resultis iffProcTable lshift 8
// 				]
// 			let xtbFirst = pfop ! 1
// 
// 			pfop ! 2 = parsacred>>PAR.xrightmarg
// 			tard = table
// 				[ 146 lshift 8 + 2 lshift 4 + 2;
// 				ardStdX;
// 				]
// 			let tab = AbGetArg(pfop, tard)
// 			if tab gr 0 then
// 				[
// 				ab = tab
// 				resultis fopNil
// 				]
// 			if tab eq abSameAs then
// 				[
// 				unless parsacred>>PAR.fOldtab do
// 					pfop ! 1 = SiPut(siNil, ttblsacred)
// 				resultis iffProcTable lshift 8
// 				]
// 
// 			let ctb = nil
// 			augmentomseq("*140")
// 			let fGetInt = FGetUserInt(lv ctb, 147)
// 			deactivateomseq("*140", "*140")
// 			unless fGetInt do
// 				[
// 				ab = abIllParam
// 				resultis fopNil
// 				]
// 			let tmod = nil
// 			let dxtb = divmod(pfop ! 2 - xtbFirst, ctb, lv tmod)
// 			let ttbl = vec lnttblMax
// 			let mpitbxtb = lv ttbl>>TTBL.ampitbxtb
// 			mpitbxtb ! 0 = xtbNil
// 			for itb = 0 to ctb-1 do
// 				mpitbxtb ! itb = xtbFirst + mult(itb, dxtb)
// 			ttbl>>TTBL.cw = ctb + 2
// 			pfop ! 1 = SiPut(siNil, ttbl)
// 			resultis iffProcTable lshift 8 + ufopFIncrement
// 			]

case $?:		iffQuery lshift 8 + 0

case $h:	valof	[
			SetRegionSys(risyspast, (vfDiablomode ? 129, 130))
			updatedisplay();
			pfop ! 1 = true
			resultis iffMagnify lshift 8
			]

case $H:	valof	[
			pfop ! 1 = false
			resultis iffMagnify lshift 8
			]

case $M:	valof	[
			SetRegionSys(risysstate, 128)
			let tch = -1;
				[
				SetRegionSys(risyspast, (vfDiablomode ? 129, 130))
				updatedisplay();
				if tch ne -1 then break;
				tch = uc(bravochar())
				test tch eq $H ifso
					vfDiablomode = false
				ifnot test tch eq $D ifso
					vfDiablomode = true
//				ifnot test tch ge $0 & tch le $9 ifso
//					[
//					vmagLook = mult(10,
//						tch - (tch ls $5 ? $0-10, $0))
//					if vmagLook eq 100 then
//						vmagLook = 101
//					break
//					]
				ifnot	
					resultis fopNil
				] repeat
			pfop ! 1 = true
			resultis iffMagnify lshift 8
			]

default:		valof	[
			let tch = uc(ch);
			if tch ne ch then
				[
				ch = tch;
				loop;
				];
			resultis fopNil;
			]
		];
	break;
	] repeat;

resultis fop;

] // end FopLookAux


and colorInterpret(str) = valof
[	// take the users description and turn it into internal form
	// for now, the transformation is trivial
resultis selecton str into
	[
case $A:	1	// Aqua

case $B:	0	// Black

case $C:	2	// Cyan

case $D:	3	// DarkBrown

case $G:	4	// Green

case $L:	5	// Lime

case $M:	6	// Magenta

case $O:	7	// Orange

case $P:	8	// Pink

case $R:	9	// Red

case $S:	10	// Smoke

case $T:	11	// Turquoise

case $U:	12	// UltraViolet

case $V:	13	// Violet

case $Y:	14	// Yellow

case $W:	15	// White

default:	-1	// Unknown
	]
]