// PressFs.sr Module
// last modified
// RML November 8, 1977  5:36 PM press-handle multiple font sets correctly

get "BRAVO1.DF";
get "ALTOFILESYS.D";
get "Q.DF";
get "EARS.DF";
get "format.DF";
get "font.DF";
get "com.df"

// Incoming Procedures

external [
	errhlta
	movec;
	ugt
	SetVab
	];

// Incoming Statics

external [
	freee
	freet
	vfe;
	fsncur;
	mpfsncrecfm;
	mpfsncrecfsp;
	macfsn;
	mpfsnfs;
	mpfunfafe;
	mpfunfd;
	mpCrockLrec2
	];

// Outgoing Procedures

external [
	assignfe;
	assignfs;
	resetmpfunfafe;
// 	ffssubset;
	findfunfa;
	getmpfefactive;
	setmpfefactive;
	Lrec2;
	];

//local manifest
manifest	[
	cwEtherAlloc= #5163
	]


// A S S I G N F E
//
let assignfe(fsn,fun,fa) = valof
	[
	if fsn eq fsndef then resultis fenil;
	let fs = mpfsnfs ! fsn
	let tmpfefunfa = lv (fs >> FS.rvmpfefunfa);
	let tfunfa = nil;
	for ife = 0 to 15 do
		[ tfunfa = tmpfefunfa ! ife;
		if tfunfa eq funfanil then
		// font-entity free; assign it
			[ tfunfa << FUNFA.fun = fun;
			tfunfa << FUNFA.fa = fa;
			tmpfefunfa ! ife = tfunfa;
			mpfunfafe ! ((fun lshift 2)+fa) = ife;
			resultis ife;
			]
		]
	resultis fenil;
	]


// A S S I G N F S
//
and assignfs(oldfsn,fun,fa,alloc) = valof
	[
	let oldfs = mpfsnfs ! oldfsn
	if macfsn eq maxfsn then 
		[
		SetVab(abmsg,false,223,50)	//too many font sets
		resultis fsnnil;
		]
	if (freee - freet) ls (lnfs+cwEtherAlloc) then 
		[
		SetVab(abmsg,false,224,50)	//not enough core for fs
		resultis fsnnil
		]
	let tfs = alloc(lnfs);
	let tmpfefunfa = lv (tfs >> FS.rvmpfefunfa);
	let tmpfefn = lv (tfs >> FS.rvmpfefn);
	movec(tmpfefunfa,tmpfefunfa+15,funfanil);
	movec(tmpfefn,tmpfefn+15,fnnil)

////	tfs >> FS.mpfefactive = oldfs >> FS.mpfefactive	// WHY??
	tfs >> FS.mpfefactive = 0

	tfs >> FS.lfm = 0
	let ffirst = true;
	let fenew =fenil;
	vfe = fenew;
	for ife = 0 to 15 do
		test getmpfefactive(tfs,ife) ne 0
		ifso	[ let funfa = (lv (oldfs >> FS.rvmpfefunfa)) ! ife
			tmpfefunfa ! ife = funfa
			] 
		ifnot	[ if ffirst then
				[ fenew = ife;
				ffirst = false;
				]
			]
	if fenew eq fenil then 
		[
		SetVab(abmsg,false,225,50)	//too many fonts
		resultis fsnnil;
		]
	vfe = fenew;
	(tmpfefunfa ! fenew) << FUNFA.fun = fun;
	(tmpfefunfa ! fenew) << FUNFA.fa = fa;
	mpfsnfs ! macfsn = tfs;
	macfsn = macfsn+1;
	resetmpfunfafe(macfsn-1);
	resultis macfsn-1;
	]

// F I N D F U N F A
//
and findfunfa(mpfefunfa,fun,fa) = valof
	[
	for ife = 0 to 15 do
		[ let tfunfa = mpfefunfa ! ife;
		if (tfunfa << FUNFA.fun eq fun) & (tfunfa << FUNFA.fa eq fa) then resultis ife;
		]
	resultis -1;
	]

// R E S E T M P F U N F A F E
//
and resetmpfunfafe(fsnnew) be
	[
	movec(mpfunfafe,mpfunfafe+14*4-1,fenil);
	let newfs = mpfsnfs ! fsnnew;
	for ife = 0 to 15 do
		[ let tfunfa = (lv(newfs >> FS.rvmpfefunfa)) ! ife;
		if tfunfa eq funfanil then loop
		mpfunfafe ! (((tfunfa << FUNFA.fun)lshift 2) + tfunfa << FUNFA.fa) = ife;
		]
	]


// S E T M P F E F A C T I V E
//
and setmpfefactive(fs,fe) be
	[
	fs >> FS.mpfefactive = (fs >> FS.mpfefactive) % (1 lshift (15-fe));
	]


// G E T M P F E F A C T I V E
//
and getmpfefactive(fs,fe) = valof
	[
	resultis (fs >> FS.mpfefactive) & (1 lshift (15-fe));
	]

// L R E C 2
//
and Lrec2(fun,fa) = valof
[ test fun ls maxfun ifso
	[ let fd = mpfunfd ! fun
	let fdh = (lv (fd >> FD.fdh))
	resultis (lv (fdh >> FDH.ampFaLrec2)) ! fa
	] 
ifnot	resultis mpCrockLrec2 ! (fun-maxfun)
]