// QFONT.SR	Fonts

get "BRAVO.DF"
get "CHAR.DF"
get "GINN.DF" // **

// Incoming procedures

external
	[
	OPENAFILE
	RESETS
	READVEC
	CLOSEAFILE
	stappend
	FileLength
	hpalloca
	move
	createdisplay
	loadcore;
	fnalloc;
	open;
	deallocfn;
	]

// Incoming statics

external
	[
	stcopy
	sbpast
	rgxlast
	rgdlfirst
	rgupdate
	mpfnof;
	]

// Outgoing procedures

external
	[
	getfont;
	changefont;
	initfontwidth;
	]

// Outgoing statics

external
	[
	vrgcc
	rgrgcc
	vheight
	heightstd;
	rgfont
	mpfunsb
	rgccstd;
	fontstd;
	vfont;
	vrightadjust;
	]

// Local statics

static
	[
	vrgcc
	rgrgcc
	vheight
	heightstd;
	rgfont
	mpfunsb
	rgccstd;
	fontstd;
	vfont;
	vrightadjust;
	]

// G E T F O N T 
// catalogue no.
let getfont(fun) = valof
[ let sbnoopen = vec (10+sbfnaml);
let cvec = nil;
let pfont = nil;
sbnoopen ! 0 = 0;
stcopy(sbnoopen," Could not open ");
test rgfont ! fun ne 0 ifso
	resultis rgfont ! fun;
ifnot	[ unless open(fnfont,mpfunsb ! fun,false) do
		[ stappend(sbnoopen,mpfunsb ! fun)
		stappend(sbnoopen," - ");
		stcopy(sbpast,sbnoopen);
		resultis -1;
		] 
	let macpos = (mpfnof ! fnfont) >> OF.macpos;
// ** GYPSY CHANGED:
	let siz = (macpos rshift 1)+1;
	pfont = hpalloca(siz+extrafont);
// ** END GYPSY CHANGE
	loadcore(fnfont,pfont);
// ** GYPSY ADDED:
	let pf = pfont+2
	let pdummy = pfont+siz+extrafont-2
	pf ! chmod = pdummy - (pf+chmod) // **Pt to extra char width
	pdummy ! 0 = 1 // ** means 0 width
	pdummy ! 1 = 0 // ** means 0 height and baseline
// ** END GYPSY ADDITION
	rgfont ! fun = pfont;
	let trgcc = hpalloca(256);
	move(vrgcc,trgcc,256);
	initfontwidth(rgfont ! fun,trgcc);
	rgrgcc ! fun = trgcc;
	deallocfn(fnfont);
	resultis rgfont ! fun;
	] 
] 

// C H A N G E F O N T
// catalogue no. = 123
and changefont(ww,font,height,rgcc) be
[ let heightorig = vheight;
test height eq heightorig ifso
	[ rgxlast ! (rgdlfirst ! ww) = -1;
	rgupdate ! ww = true;
	] 
ifnot	createdisplay( );
] 

// I N I T F O N T W I D T H 
// catalogue no. = 
and initfontwidth(font,rgcc) be
[ let char1 = nil;
let wdch = nil;
let width = nil;
font = font+2;
for char = 0 to #377 do
	[ char1 = char;
	width = 0;
		[ wdch = rv (font+char1+font ! char1);
		if wdch & 1 then
			[ width = width+(wdch rshift 1);
			break;
			] 
		width = width+16;
		char1 = wdch rshift 1;
		] repeat
	(rgcc + char) >> CC.width = width;
	]
(rgcc+chcr) >> CC.width = 8;
(rgcc+chtab) >> CC.width = 8;
]