// install.sr
// last modified
// RML October 11, 1977  10:32 AM add alternate Net Address
// RML December 23, 1977  4:31 PM save all Net addresses
// RML January 4, 1978  1:19 PM defer PrintedBy processing

// Last modified November 30, 1979  2:15 PM by Taft

get "BRAVO1.DF";
get "ALTOFILESYS.D";
get "VM.DF";
get "FONT.DF";
get "FORMAT.DF";
get "MSG.DF";
get "DISPLAY.DF";
get "MEASURE.DF";
get "PARAM.DF";
get "ST.DF";

// Incoming Procedures

external [
	stcompare;
	sbwsize;
	sttoint;
	ult;
	movec;
	stcopy;
	array;
	divmod;
	ratio;
	errhlta
	errhlt
	ofinduserprof;
	array1;
	settabs;
	stget;
	DAYTIME;
	FtyOpen;
	FcGetParam;
	FcFindLabel;
	move
	stappend
	min
	];

// Incoming Statics

external [
	mpfunfd;
	vfddfirst;
// 	vfdd0;
	vofsetstd
	vldlnstd
	vldhdrstd
	vxleftmarg;
	vxrightmarg;
	vdxrightmarg
	vdxleftmarg
	vdxleftmargf
	vmeasurestatus
	mpWwWwd
	vheightd
	vyorig
	parstd;
	quitchar;
	vbttoti;
	vbttotd;
	mpfnof;
	vtodstart;
	vcpagehc;
	vdxtbStd
	vslPrintBy;
	UserName;
//	vsbEarsNetAddress
	vsbPressNetAddress
	vsbAltPressNetAddress
//	vfEars;
	vfDiablomode
	];

// Outgoing Procedures

external [
	CreateFd;
	inituserparams;
	chuckinitmeasure;
	InstallParams;
	]; 

// Outgoing Statics

external [
	vffakeether;
// 	vSDD
	vfloppy;
	vpgpertrk;
	vmsskpertrk;
	vmsheadld;
	vmstransperpg;
	vxleftmargstd;
	vxrightmargstd;
	vxleftmargfstd;
	vytop;
	vymid;
	vybot;
	mpCrockLrec2
	look1std
	look2std
	]; 


// Outgoing Statics


static [
	vffakeether;
// 	vSDD
	vfloppy;
	vpgpertrk;
	vmsskpertrk;
	vmsheadld;
	vmstransperpg;
	vxleftmargstd;
	vxrightmargstd;
	vxleftmargfstd;
	vytop;
	vymid;
	vybot;
	mpCrockLrec2
	look1std
	look2std
	] 

manifest [ vcNewestOrNew = 4; manMaxMagi = 5 ] 

// C R E A T E F D
//
let CreateFd(alloc) be
[ mpfunfd = alloc(maxfun,0);
vfddfirst = 0;
let t = nil;
// vfdd0 = -1
let ffirst = true
let fcFirst = 0;
let prm = vec lprmovh+40; prm >> PRM.cchMax = 80
let prmInt = vec lprmovh+5; prmInt >> PRM.cchMax = 10
let tfd = vec fdl+40
// let tfd = vec fdl+manMaxMagi+fdhl+40
// tfd >> FD.maxmagi = manMaxMagi
// let trgfdd = lv (tfd >> FD.rvrgfdd);
// movec(trgfdd,trgfdd+manMaxMagi-1,0);
let tfdh = lv tfd>>FD.fdh;
let mpfargcc = lv(tfdh >> FDH.rvmpfargcc);
movec(mpfargcc,mpfargcc+3,0);
let mpfafunfadef = lv(tfdh >> FDH.rvmpfafunfadef);
movec(mpfafunfadef,mpfafunfadef+3,funfanil);
	[ fcFirst = FcFindLabel("FONT",prm,fnuser,fcFirst,"BRAVO")
	if prm >> PRM.pt eq ptNil then
		break
	fcFirst = FcGetParam(fnuser,fcFirst,prm)
// check for label ?
	let fun = nil
	test stcompare("D", lv prm >> PRM.astr) eq 0 ifso
		fun = 10
	ifnot fun = sttoint(lv prm >> PRM.astr);
// ???
	unless ult(fun,maxfun) do errhlta(172);
	fcFirst = FcGetParam(fnuser,fcFirst,prm)
// check for label ?
	stcopy(lv(tfdh >> FDH.rvsbname),lv prm >> PRM.astr);
	fcFirst = FcGetParam(fnuser,fcFirst,prm)
// check for label ?
	tfdh >> FDH.height = sttoint(lv prm >> PRM.astr);
	tfdh >> FDH.bl = divmod(tfdh >> FDH.height,5,t);
	movec(lv tfdh >> FDH.ampFaLrec2,lv tfdh >> FDH.ampFaLrec2+3,0)	// 0 should be lrec2Nil
// 	let maxmagi = nil
// 	for magi = 0 to manMaxMagi-1 do
	for ti = 0 to 1 do
		[ let fcNext = FcGetParam(fnuser,fcFirst,prm)
		if prm >> PRM.pt ne ptparam then
			[ if ti eq 0 then errhlta(248, fun)
			tfd>>FD.fddSmall = tfd>>FD.fddLarge;
			break
			];
//		if prm >> PRM.pt ne ptparam then errhlta(248, fun)
// 		maxmagi = magi+1
		fcFirst = FcGetParam(fnuser,fcNext,prmInt)
		if prm >> PRM.pt ne ptparam then errhlta(248, fun)
// check for label ?
		let theight = sttoint(lv prmInt >> PRM.astr);
		let fdd1 = vfddfirst;
		let fdd = nil;  let sbFontName = lv prm >> PRM.astr
		while fdd1 ne 0 do
			[ if (stcompare(sbFontName,lv fdd1 >> FDD.rvsbname) eq 0) & (fdd1 >> FDD.height eq theight) then
				[ 
				fdd = fdd1;
// 			fdd = array(fddlshort);
// 				fdd >> FDD.fddindirect = fdd1;
				break;
				] 
			fdd1 = fdd1 >> FDD.fddnext;
			] 
		if fdd1 eq 0 then
			[ fdd = array(fddl+sbwsize(sbFontName)-1);
// 			fdd >> FDD.fddindirect = 0;
			fdd >> FDD.fddnext = vfddfirst;
			vfddfirst = fdd;
			fdd >> FDD.font = 0;
			fdd >> FDD.rgcc = 0;
			fdd >> FDD.lru = 0;
			fdd >> FDD.bl = divmod(theight,5,lv t);
			fdd >> FDD.faulted = false;
			fdd >> FDD.height = theight;
			fdd >> FDD.lfile = 0;
// 			if ffirst & (fun eq 0) then
// 				[ ffirst = false;
// 				vfdd0 = fdd;
// 				] 
			stcopy(lv (fdd >> FDD.rvsbname),sbFontName);
			] 
// 		fdd >> FDD.mag = ratio(theight,100,tfdh >> FDH.height);
// 		trgfdd ! magi = fdd;
		(lv (tfd>>FD.fddLarge)) ! ti = fdd;
		] 
	let cwSbName = sbwsize(lv tfdh >> FDH.rvsbname)
// 	let fd = alloc(fdl+maxmagi+fdhl+cwSbName);
// 	fd >> FD.maxmagi = maxmagi;
	let cwFd = fdl+cwSbName;
	let fd = alloc(cwFd);
	mpfunfd ! fun = fd;
	move(tfd,fd,cwFd);
// 	let rgfdd = lv (fd >> FD.rvrgfdd);
// 	move(trgfdd,rgfdd,maxmagi);
// 	let fdh = rgfdd+maxmagi;
// 	move(tfdh,fdh,fdhl+cwSbName-1);
	] repeat
// if vfdd0 eq -1 then errhlta(174);
// let height0 = vfdd0 >> FDD.height;
// for tfun = 0 to maxfun-1 do
// 	[ let fd = mpfunfd ! tfun;
// 	if fd eq 0 then loop
// 	let rgfdd = lv (fd >> FD.rvrgfdd);
// 	let fdh = rgfdd+fd >> FD.maxmagi
// 	let fdd = array(fddlshort);
// 	fdd >> FDD.mag = ratio(height0,100,fdh >> FDH.height);
// 	fdd >> FDD.fddindirect = vfdd0;
// 	rgfdd ! (-1) = fdd;
// 	] 
mpCrockLrec2 = array1(3,0)
// fillinfdd(vfdd0)
] 

// I N S T A L L P A R A M S
//
and InstallParams() be
[ vmeasurestatus = 0;
inituserparams("MEASURE",lv vmeasurestatus)
if vmeasurestatus ne 0 then chuckinitmeasure("A",array1)
vxleftmargstd = xleftmargstd;
vxleftmargfstd = xleftmargstd;
vxrightmargstd = xrightmargstd;
vdxtbStd = dxtbStd;
inituserparams("TABS", lv vdxtbStd);
inituserparams("MARGINS",lv vxleftmargfstd,lv vxleftmargstd,lv vxrightmargstd);
vfloppy = false;
vmstransperpg = 0;
vmsskpertrk = 0;
vmsheadld = 0;
vpgpertrk = 0;
inituserparams("FLOPPYDISK",lv vfloppy,lv vmstransperpg,lv vmsskpertrk,lv vmsheadld,lv vpgpertrk);
// vSDD = false;
// inituserparams("SDD", lv vSDD)
// defaulted in initformat 
// vdxleftmarg = 0;
// vdxrightmarg = 0;
// vdxleftmargf = 0;
inituserparams("NESTED",lv vdxleftmarg,lv vdxrightmarg);
vofsetstd = ofsetstd;
inituserparams("OFFSET",lv vofsetstd);
vldlnstd = ldlnstd;
vldhdrstd = ldhdrstd;
inituserparams("LEAD",lv vldlnstd,lv vldhdrstd);
vheightd = 14;
vytop = vyorig+5; vymid = vytop+3*(vheightd+2)+6; vybot = #1400
inituserparams("SCREEN",lv vytop,lv vymid,lv vybot);
InitDefaultLooks()
InitHcOptions();
] 

// I N I T U S E R P A R A M S
//
and inituserparams(sblabel,rvrglvparam,nil,nil,nil,nil,nil,nil,nil,nil,nil,nil; numargs n) be
	[ let prm = vec lprmovh+40; prm >> PRM.cchMax = 80
	let fcFirst = FcFindLabel(sblabel,prm,fnuser,0,"BRAVO")
	if prm >> PRM.pt eq ptNil then
		return;
	let rglvparam = lv rvrglvparam;
	let tchar = nil;
	let sbnorm = vec 50;
	sbnorm ! 0 = 0;
	for iparam = 0 to n-2 do
		[
			[ fcFirst = FcGetParam(fnuser,fcFirst,prm)
			if (prm >> PRM.pt eq ptparam) & (stcompare(lv prm >> PRM.astr,"=") eq 0) then
				break
			] repeat
		fcFirst = FcGetParam(fnuser,fcFirst,prm)
		LowerCaseSb(lv prm >> PRM.astr);
		tchar = stget(lv prm >> PRM.astr,0);
		let tpv = nil
		test ((tchar ge $0) & (tchar le $9)) % (tchar eq $+) % (tchar eq $-)
		ifso	tpv = sttoint(lv prm >> PRM.astr);
		ifnot	tpv = (stcompare(lv prm >> PRM.astr,"true") eq 0) ? -1,0;
		(rv (rglvparam ! iparam)) = tpv;
		]
	]


// C H U C K I N I T M E A S U R E
//
and chuckinitmeasure(sb,alloc) be
[ unless stcompare(sb,"A") eq 0 then errhlta(176);
quitchar = 0;
vmeasurestatus << MEASURESTATUS.p = true;
vmeasurestatus << MEASURESTATUS.q = true;
//vbttoti = alloc(2,0);
//vbttotd = alloc(2,0);
//vcpagehc = 0;
//vtodstart = alloc(lntod);
//DAYTIME(vtodstart);
FtyOpen(fnmeasure,"USER.MEASURE",false,false,vcNewestOrNew);
(mpfnof ! fnmeasure) >> OF.wf = true;
(mpfnof ! fnmeasure) >> OF.pos = (mpfnof ! fnmeasure) >> OF.macpos;
] 

// I N I T  H C  O P T I O N S
//
and InitHcOptions() be
[ let prm = vec lprmovh+40; prm >> PRM.cchMax = 80
let fcFirst = FcFindLabel("PREFERREDFORMAT",prm,fnuser,0,"HARDCOPY")
test prm >> PRM.pt eq ptNil ifso
	[
//	vfEars = true
	vfDiablomode = false;
	]
ifnot
	[
	fcFirst = FcGetParam(fnuser,fcFirst,prm)
	let tsb = lv prm >> PRM.astr;
	LowerCaseSb(tsb)
	test stcompare(tsb, "diablo") eq 0 ifso
		[
		vfDiablomode = true
//		vfEars = false
		]
	ifnot test stcompare(tsb, "press") eq 0 ifso
		[
		vfDiablomode = false
//		vfEars = false
		]
	ifnot 
		[
		vfDiablomode = false
//		vfEars = true
		]
	]

fcFirst = FcFindLabel("PRINTEDBY",prm,fnuser,0,"HARDCOPY")
test prm >> PRM.pt eq ptNil ifso
	[ vslPrintBy = array((UserName>>SB.cch+2)/2);
	vslPrintBy>>SB.cch = 1;
	stappend(vslPrintBy, UserName);
	vslPrintBy>>SL.cch = vslPrintBy>>SB.cch - 1;	// turn back into sl
	]
ifnot
	[
	fcFirst = FcGetParam(fnuser,fcFirst,prm,false)
	let tsl = lv prm >> PRM.astr;
	let tl = (tsl >> SL.cch+3)/2;
	vslPrintBy = array(tl);
	move(tsl, vslPrintBy, tl)
	]

// if vfDiablomode eq false then
	[
//	vsbEarsNetAddress = 0 
	vsbPressNetAddress = 0 
	vsbAltPressNetAddress = 0

//	parseNetAddress(lv vsbEarsNetAddress, prm, "EARS")
	parseNetAddress(lv vsbPressNetAddress, prm, "PRESS")
	parseNetAddress(lv vsbAltPressNetAddress, prm, "COLOR-PRESS")

//	if vsbEarsNetAddress eq 0 then
//		[ vsbEarsNetAddress = array(4);
//		stcopy(vsbEarsNetAddress, "3#3#")
//		]
	if vsbPressNetAddress eq 0 then
		[ vsbPressNetAddress = array(11);
		stcopy(vsbPressNetAddress, "PrinterNameUndefined")
		]
	if vsbAltPressNetAddress eq 0 then
		vsbAltPressNetAddress = vsbPressNetAddress
	]
] 


// P A R S E N E T A D D R E S S
//
and parseNetAddress(varAddr, prm, name) be
[
let fcFirst = FcFindLabel(name,prm,fnuser,0,"HARDCOPY")
unless prm >> PRM.pt eq ptNil do
	[
	fcFirst = FcGetParam(fnuser,fcFirst,prm)
	let tsb = lv prm >> PRM.astr
	tsb>>SB.cch = min(tsb>>SB.cch, 19)  // limit of HO.asbNetAddress
	let tl = (tsb >> SB.cch+2)/2
	@varAddr = array(tl)
	move(tsb, @varAddr, tl)
	]
]


//  L O W E R  C A S E  S B
//
and LowerCaseSb(sb) be
[ for ich = 0 to sb>>SB.cch-1 do
	[ let tch = sb>>SB.ch↑ich;
	if (tch ge $A) & (tch le $Z) then sb>>SB.ch↑ich = tch % #40;
	];
]


and InitDefaultLooks() be
[ let prm = vec lprmovh+40; prm >> PRM.cchMax = 80
let fcFirst = FcFindLabel("LOOKS",prm,fnuser,0,"BRAVO")
if prm >> PRM.pt ne ptNil then
	[
	fcFirst = FcGetParam(fnuser,fcFirst,prm,false)
	let tsb = lv prm >> PRM.astr;
	for ich = 0 to tsb>>SB.cch-1 do
		[
		let ch = tsb>>SB.ch↑ich
		let on = ch ge $a
		ch = ch % 40B
		switchon ch into
			[
			case $g:
				look1std<<LOOK1.ext = on; endcase
			case $v:
				look1std<<LOOK1.visible = on; endcase
			case $b:
				look1std<<LOOK1.boldface = on; endcase
			case $i:
				look1std<<LOOK1.italic = on; endcase
			case $0 to $9:
				look2std<<LOOK2.fun = ch-$0; endcase
			]
		]
	]
]