// hcparam.sr
// Bcpl/f hcparam.sr

// last modified
// RML - add number of colors request - September 17, 1977  9:43 PM
// RML - change color command to $. - September 21, 1977  6:02 PM
// RML - September 24, 1977  3:32 PM fix mior bugs
// RML - October 11, 1977  11:15 AM  add alternate Net Address
// RML - December 23, 1977  4:14 PM save all Net addresses
// PCL  - April 7, 1978 11:00 AM add envelope mode
// RML - April 12, 1978  4:52 PM single page color Press file
// RML - April 13, 1978  1:35 PM change "E" to Envelope, "." to B, Ears to "O", Diablo to "H", and "D" to Dover (Press) 

// Last modified November 30, 1979  2:06 PM by Taft
// I abolished Ears and restored "D" = Diablo.

get "BRAVO1.DF"
get "CHAR.DF"
get "ST.DF"
get "ALTOFILESYS.D"
get "FONT.DF"
get "DIR.DF"
get "COM.DF"
get "RN1.DF"
get "HARDCOPY.DF"
get "MSG.DF"


// Incoming Procedures

external	[
	SetRegionSys
	bravochar
	updatedisplay
	FGetUserInt
	fillinfonth
	inserttx
	mapcp
	CpParseDocProf
	DefaultHo
	readsel
	augmentomseq
	ofnamfilter
	deactivateomseq
	stsize
	FtyOpen
	stnum
	SetRegionW
	uc
	move
	stappend
	stcopy
	umin
	SlAppend;
	array;
	MoveX
	stcompare
	blinkscreen
	]


// Incoming Statics

external	[
	mpfunfd
	vmapstatus
	parsacred
	tsread
	rgmaccp
	vfwheel
	vrlwsys
	tsmacro
//	vfEars
	vslPrintBy
	vesccom
	UserName;
	]


// Outgoing Procedures

external	[
	AbHcParams
	HcDefaultPrintingServer
	]


// Outgoing Statics

external	[
//	vsbEarsNetAddress
	vsbPressNetAddress
	vsbAltPressNetAddress
	vfDiablomode
	vfEarsFile
	EnvelopeFlag
	EnvelopeCpLast
	]


// Local Statics

static	[
//	vfEars
//	vsbEarsNetAddress
	vsbPressNetAddress
	vsbAltPressNetAddress
	vslPrintBy
	vfDiablomode
	vfEarsFile
	EnvelopeFlag
	EnvelopeCpLast
	EnvelopeSelected
	]


// Local Manifests

manifest	[
	doctx1 = 1	// no room for df's
	doctx3 = 3
	fnput = 3
	]


// A B   H C   P A R A M S
// cf>>CF.w0 = nmd
// cf>>CF.w1 = cpFirst
// cf>>CF.w2 = fNoTrunc
// cf>>CF.w3 etc = ho>>HO.ccopy etc

let AbHcParams(cf, ho) = valof
[ 
let sel = cf>>CF.sel
let nmd = cf>>CF.w0
let sbfnam = vec 40
let nColor = nil

let cpFirst = 0
vmapstatus = statusblind
mapcp(sel>>SEL.doc, 0, parneeded)
test parsacred>>PAR.control ifso
	[
	cpFirst = CpParseDocProf(ho, sel>>SEL.doc, 0)
	if cpFirst eq cpnil then resultis abmsg
	]
ifnot	DefaultHo(ho)
cf>>CF.w1 = cpFirst

// ***
// vfEars = true
// vslNetAddress = " 3#3"
// vslNetAddress>>SL.cch = vslNetAddress>>SB.cch - 1
// vslPrintBy = array(20);
// vslPrintBy>>SB.cch = 1
// stappend(vslPrintBy, UserName);
// vslPrintBy>>SL.cch = vslPrintBy>>SB.cch - 1;	// turn back into sl
// ***

vesccom = false;
test cf>>CF.frepeat ifso
	move(lv cf>>CF.w3, lv ho>>HO.ccopy, lnhoCf)
ifnot
	[
	ho>>HO.ccopy = 1;
	ho>>HO.pgnStartPrint = ho>>HO.pgnFirst;
	ho>>HO.fDiablo = vfDiablomode;
	ho>>HO.fFile = false;
//	ho>>HO.fNetAddress = false;
//	move(vslNetAddress, lv ho>>HO.aslNetAddress, cwNetAddress);
	ho>>HO.fEars = false;
	ho>>HO.fColor = false;
//	ho>>HO.fPrintBy = false;
//	move(vslPrintBy, lv ho>>HO.aslPrintBy, cwPrintBy);
	]

ho>>HO.fNetAddress = false;
//move((vfEars ? vsbEarsNetAddress, vsbPressNetAddress), lv ho>>HO.asbNetAddress, cwNetAddress);
move(vsbPressNetAddress, lv ho>>HO.asbNetAddress, cwNetAddress);
ho>>HO.fPrintBy = false;
ho>>HO.nColor = 1;	// allow color

move(vslPrintBy, lv ho>>HO.aslPrintBy, cwPrintBy);

	[ 
	move(lv ho>>HO.ccopy, lv cf>>CF.w3, lnhoCf)
	SetRegionSys(risysstate, 73)
	ShowHcOptions(ho)
	let ch = bravochar()
	SetRegionSys(risysstate, rinil)
	SetRegionSys(risyspast, rinil)
	updatedisplay()
	switchon uc(ch) into 
		[
case $C:
		unless FGetUserInt(lv ho>>HO.ccopy, 153) do
			resultis abIllOpt
		endcase

case $S:
		[
		unless FGetUserInt(lv ho>>HO.pgnStartPrint, 164) do
			resultis abIllOpt
		unless ho>>HO.pgnStartPrint ge ho>>HO.pgnFirst do
			resultis abBadPage
		]
		endcase

case $H:		// HYTYPE
case $D:		// Diablo
		[
		let fd = mpfunfd ! funDiablo
		if fd eq fdnil then
			resultis abDiabloFont
		let fdh = (lv fd>>FD.fdh)
// 		unless fdh>>FDH.rvmpfargcc ne 0 %
//		  fillinfonth(funDiablo, 0) then
		unless fdh>>FDH.rvmpfargcc ne 0 then
			resultis abDiabloFont
		]
		ho>>HO.fDiablo = true
		EnvelopeFlag = false
		endcase

case $E:			// Envelope
		[
		let fd = mpfunfd ! funDiablo
		if fd eq fdnil then
			resultis abDiabloFont
		let fdh = (lv fd>>FD.fdh)
// 		unless fdh>>FDH.rvmpfargcc ne 0 %
//		  fillinfonth(funDiablo, 0) then
		unless fdh>>FDH.rvmpfargcc ne 0 then
			resultis abDiabloFont
		]
		ho>>HO.fDiablo = true
		EnvelopeFlag = true
		EnvelopeCpLast = true		//Init
		EnvelopeSelected = 0
		ShowHcOptions(ho)
		inserttx(1)			//**PCL
		EnvelopeSelected = 1
		ShowHcOptions(ho)
		break

case $F:
		SetRegionSys(risysstate, 154, 37)
		updatedisplay()
		unless inserttx(3) do
			resultis abComTerm
		ho>>HO.fDiablo = false
		ho>>HO.fFile = true
		endcase

case $@:
		SetRegionSys(risysstate, 235, 37)	// "Type net addr..."
		updatedisplay()
		unless inserttx(1) do
			resultis abComTerm
		readsel(lv ho>>HO.asbNetAddress, doctx1, 0, rgmaccp ! doctx1-1, 18)
// 		[
// 		let tsl = lv ho>>HO.aslNetAddress;
// 		tsl>>SB.cch = 1;	// note SB !!
// 		stappend(tsl, sbfnam);
// 		tsl>>SL.cch = tsl>>SB.cch - 1;	// turn back into sl
// 		]
		ho>>HO.fDiablo = false
		ho>>HO.fFile = false
		ho>>HO.fNetAddress = true
		endcase

//case $E:		// EARS
//		ho>>HO.fDiablo = false
//		ho>>HO.fEars = true
//		move(vsbEarsNetAddress, lv ho>>HO.asbNetAddress, cwNetAddress);
//		ho>>HO.fColor = false
//		endcase
case $P:		// PRESS
		ho>>HO.fDiablo = false
//		ho>>HO.fEars = false
		move(vsbPressNetAddress, lv ho>>HO.asbNetAddress, cwNetAddress);
		ho>>HO.fColor = false
endcase

case $B:		// This has been changed to mean:
		// no matter what's in the file, produce a Press
		// file which can be printed on a B/W printer
		// the net address is set to PRESS
		// nColor to 0 (Black)

		ho>>HO.fDiablo = false
//		ho>>HO.fEars = false
		move(vsbPressNetAddress, lv ho>>HO.asbNetAddress, cwNetAddress);
		ho>>HO.fNetAddress = true
		ho>>HO.nColor = 0
		ho>>HO.fColor = false
		endcase

case $N:
		SetRegionSys(risysstate, 234, 37)	// "Type user name..."
		updatedisplay()
		unless inserttx(1) do
			resultis abComTerm
		readsel(sbfnam, doctx1, 0, rgmaccp ! doctx1-1, 38)
		[
		let tsl = lv ho>>HO.aslPrintBy;
		tsl>>SB.cch = 1;	// note SB !!
		stappend(tsl, sbfnam);
		tsl>>SL.cch = tsl>>SB.cch - 1;	// turn back into sl
		]
		ho>>HO.fDiablo = false
		ho>>HO.fPrintBy = true
		endcase

case chdel:
		resultis abComTerm

case chcr:
		break

default:
		resultis abIllOpt
		]
	] repeat

vfDiablomode = ho>>HO.fDiablo
vfEarsFile = ho>>HO.fFile
ho>>HO.lnLast = 0
// (lv ho>>HO.asbPgn)>>SB.cch = 0

deactivateomseq("Ma*140", "Ma*140")

//if tsread  & not tsmacro then resultis abComTerm

unless ho>>HO.fDiablo do 
	[

//	clean up ho.aslPrintBy with trailing blanks

	let fNoTrunc = false
	test ho>>HO.fFile ifso
		[
		readsel(sbfnam, doctx3, 0, rgmaccp ! doctx3-1, 50)
		augmentomseq("G")
		let legalsiz = ofnamfilter(sbfnam)
		deactivateomseq("G", "G")
		if legalsiz eq mastx-3 then
			resultis abTooLong
		if legalsiz ne stsize(sbfnam) then
			resultis abIllChar
		]
	ifnot	[

//		clean up ho.aslSocket with trailing blanks

		test vfwheel ifso
			sbfnam = "bravo.press"
		ifnot	[
			sbfnam = "swatee"
			fNoTrunc = true
			]
		]

	augmentomseq("JQT")
	let fty = FtyOpen(fnput, sbfnam, true, true, vcNewestOrNew, 0, false, nmd)
	deactivateomseq("JQT", "JQT")
	if fty eq ftyNil then resultis abmsg

	cf>>CF.w2 = fNoTrunc
	]

resultis abnil
]


// S H O W   H C   O P T I O N S

and ShowHcOptions(ho) be
[
let ridCcopy = rinil
let ridCopies = rinil
let ridStartPrint = rinil
let ridPgn = rinil
let ridDiabloFileSendto = rinil
let ridFormat = rinil
let ridPrintBy = rinil

unless ho>>HO.ccopy eq 1 do
	[
	let sb = vec 5
	stnum(sb, ho>>HO.ccopy)
	SetRegionW(vrlwsys, 0, sb)
	ridCcopy<<RID.nrl = 1
	ridCcopy<<RID.ri = 0
	ridCopies = 149
	]

unless ho>>HO.pgnStartPrint eq ho>>HO.pgnFirst do
	[
	ridStartPrint = 221
	let sb = vec 5
	stnum(sb, ho>>HO.pgnStartPrint)
	stappend(sb, "   ");
	SetRegionW(vrlwsys, 1, sb)
	ridPgn<<RID.nrl = 1
	ridPgn<<RID.ri = 1
	]

test ho>>HO.fDiablo ifso [
//	ridDiabloFileSendto = 152
	ridDiabloFileSendto = 243
	if ridStartPrint eq 221 then ridDiabloFileSendto = 152
	if EnvelopeFlag then ridDiabloFileSendto = 244 + EnvelopeSelected //**PCL
		]

ifnot
	[
	test ho>>HO.fFile ifso
		 ridDiabloFileSendto = 151
		
	ifnot if ho>>HO.fNetAddress then
		[
		let sb = vec 10
		stcopy(sb, "Send to ")
		stappend(sb, lv ho>>HO.asbNetAddress);
		stappend(sb, "   ");
		SetRegionW(vrlwsys, 2, sb)
		ridDiabloFileSendto<<RID.nrl = 1
		ridDiabloFileSendto<<RID.ri = 2
		]

	ridFormat = ho>>HO.fEars ? 236, 237

	if ho>>HO.fPrintBy then
		[
		let sb = vec 15
		stcopy(sb, "Printed by ")
		SbAppendSl(sb, lv ho>>HO.aslPrintBy, 10);
		if (lv ho>>HO.aslPrintBy)>>SL.cch gr 10 then
			stappend(sb, "...");
		SetRegionW(vrlwsys, 3, sb)
		ridPrintBy<<RID.nrl = 1
		ridPrintBy<<RID.ri = 3
		]
	]

SetRegionSys(risyspast, ridCcopy, ridCopies, ridStartPrint, ridPgn,
  ridDiabloFileSendto, ridFormat, ridPrintBy)
updatedisplay()

] // end ShowHcOptions


// S B   A P P E N D   S L

and SbAppendSl(sb, sl, cchSl; numargs carg) = valof
[
cchSl = carg ls 3 ? sl>>SL.cch, umin(cchSl, sl>>SL.cch);
let tcch = sb>>SB.cch;
for ich = tcch to tcch + cchSl - 1 do
	sb>>SB.ch ^ ich = sl>>SL.ch ^ (ich - tcch);
sb>>SB.cch = tcch + cchSl;
resultis sb;
] // end SbAppendSl


and HcDefaultPrintingServer(ho) = valof
[
if ho>>HO.fColor & stcompare(vsbAltPressNetAddress, vsbPressNetAddress) ne 0 then
	[
	SetRegionW(vrlwsys, 0, vsbAltPressNetAddress)
	let ridHost = rinil
	ridHost<<RID.nrl = 1
	ridHost<<RID.ri = 0
	SetRegionSys(risysstate, 246)
	SetRegionSys(risyspast, 247, ridHost, 248)
	updatedisplay()
	switchon uc(bravochar()) into
		[
		case chdel: resultis abComTerm
		case $N: ho>>HO.fColor = false
		case $Y: break
		default: blinkscreen()
		] repeat
	SetRegionSys(risysstate, rinil)
	SetRegionSys(risyspast, rinil)
	updatedisplay()
	]
move((ho>>HO.fColor ? vsbAltPressNetAddress, vsbPressNetAddress), lv ho>>HO.asbNetAddress,  cwNetAddress)
resultis abnil
]