// initfont.sr	Fonts


get "ALTOFILESYS.D"
get "BRAVO1.DF"
get "CHAR.DF"
get "font.DF"
get "st.DF"
get "dir.DF"
get "VM.DF"


// Incoming Procedures

external	[
	errhlta
	FillInFont
	LruInc
	lockbp
	unlockbp
	errhlt
	gets
	stcompare
	ratio
	mult
	umax
	flushvm;
	]

// Incoming Statics

external	[
	mpfunfd
// 	vfdd0
	vfddfirst
	fddlrutimer
	mpfnof
	getvp
	vbp
	fontvis
	]

// Outgoing procedures

external	[
	fillinfdd
	initfontwidth
	markrgcc
	markcc
	fillinfonth
	InitFdh;
	]

// F I L L I N F D D
//
let fillinfdd(fdd) be
[
let fddInitial = fdd
// if fdd>>FDD.fddindirect then
// 	fdd = fdd>>FDD.fddindirect
let fptr = lv (fdd>>FDD.aFptr)
if fdd>>FDD.lfile eq 0 then
	[
	let tfddDft = (mpfunfd ! 0)>>FD.fddLarge;
	if fdd eq tfddDft then errhlta(16)
	for tfun = 0 to maxfun-1 do
		[ let fd = mpfunfd ! tfun
		if fd eq fdnil then loop
// 		if tfddDft>>FDD.lfile eq 0 then errhlt("dft");
		if fd>>FD.fddSmall eq fdd then
			fd>>FD.fddSmall = tfddDft
		if fd>>FD.fddLarge eq fdd then
			fd>>FD.fddLarge = tfddDft
		] 
	test fdd eq vfddfirst ifso
		vfddfirst = fdd >> FDD.fddnext
	ifnot	[ let tfdd1 = vfddfirst;
		until tfdd1 >> FDD.fddnext eq fdd do
			tfdd1 = tfdd1 >> FDD.fddnext
		tfdd1 >> FDD.fddnext = fdd >>FDD.fddnext
		] 
// 	fddInitial>>FDD.fddindirect = vfdd0
	fdd = tfddDft
// 	let ifdd = valof 
// 		[ let tifdd = 0; let tfdd = vfddfirst
// 		until tfdd eq fdd do
// 			[ tfdd = tfdd >> FDD.fddnext
// 			tifdd = tifdd+1
// 			if tfdd eq 0 then errhlt("nif")
// 			] 
// 		] 
// 	fdd = vfdd0
//  	let trid = 0
// 	trid<<RID.fun = ifdd
// 	trid<<RID.al = true		//x.al font
// 	trid<<RID.nrl = nrlmax
// 	SetVab(abmsg,mtyAnc,231,trid)
// 	let tsb = vec 15
// 	let tsb1 = vec 10
// 	tsb ! 0 = 0
// 	tsb1 ! 0 = 0
// 	stnum(tsb1, fdd>>FDD.height, 10, 0)
// 	stcopy(tsb, lv(fdd>>FDD.rvsbname))
// 	stappend(tsb, tsb1)
// 	stappend(tsb, ".AL")
// 	augmentomseq("J")
// 	fn = fnalloc()
// 	fdd>>FDD.fn = fn
// 	let nmd = vec lnmdMax; InitNmd(nmd, lnmdMax, tsb, vcNewest)
// 	FindFptr(cfaSysDirEnd, lv nmd, 0, -1)
// 	test nmd>>NMD.cver eq 0 ifso
// 		[
// 		if fdd eq vfdd0 then errhlta(16)
// 		fddInitial>>FDD.fddindirect = vfdd0
// 		fdd = vfdd0
// 		fn = fdd>>FDD.fn
// 		stcopy(sbpast, "Could not open ")
// 		stappend(sbpast, tsb)
//		vmessage = true
// 		]
// 	ifnot	[
// 		move(lv nmd>>NMD.afptr, lv fdd>>FDD.aFptr, lFP)
// 		let dblL = vec 2
// 		FindCfc(fptr, dblL)
// 		fdd>>FDD.lfile = (dblL ! 1) rshift 1
// 		]
// 	deactivateomseq("J")
	]
if fdd>>FDD.font eq 0 then
	FillInFont(fdd) 
fdd>>FDD.lru = LruInc(lv fddlrutimer)
// unfaultfdd(fdd)
if fdd>>FDD.rgcc eq 0 then
	[
	let vpa = nil
	vpa<<VPA.fn = fnscrfs
	vpa<<VPA.fp = ((mpfnof ! fnscrfs)>>OF.macpos) rshift 9
	(mpfnof ! fnscrfs)>>OF.macpos = (mpfnof ! fnscrfs)>>OF.macpos + #1000
	let trgcc = getvp(vpa)
	let tbp = vbp
	lockbp(tbp)
	FillInFont(fdd) 
	initfontwidth(fdd>>FDD.font, trgcc)
	markrgcc(trgcc)
	unlockbp(tbp, true)
	fdd>>FDD.rgcc = vpa
	flushvm();
	]
]

// I N I T F O N T W I D T H 
// catalogue no. = 
and initfontwidth(font, rgcc) be
[ if font eq 0 then errhlt("f0")
let char1 = nil
let xw = nil
let width = nil
let twidth0 = ((fontvis+chwidth0+fontvis ! chwidth0)>>ALCD.xw) rshift 1
font = font+2
for char = 0 to #377 do
	[
	char1 = char
	width = 0
		[
		xw = (font+char1+font ! char1)>>ALCD.xw
		if xw<<odd then
			[
			width = width+(xw rshift 1)
			break
			]
		width = width+16
		char1 = xw rshift 1
		] repeat
	rgcc ! char = ((xw eq xwnil) ? twidth0, width) lshift 5
	]
rgcc ! chcr = 8*32
rgcc ! chtab = 8*32
rgcc ! chlf = 0
]

// M A R K R G C C
//
and markrgcc(rgcc) be
[
markcc(rgcc, #47, #47, 0)
markcc(rgcc, #60, #71, 0)
markcc(rgcc, #141, #172, 0)
markcc(rgcc, #101, #132, 0)
markcc(rgcc, #177, #377, 1)
markcc(rgcc, 0, #40, 1)
markcc(rgcc, chsp, chsp, 2)
markcc(rgcc, chcr, chcr, 2)
markcc(rgcc, chtab, chtab, 2)
markcc(rgcc, $-, $-, 2)
]

// M A R K C C
// catalogue no.
and markcc(rgcc, chfirst, chlast, mark) be
for cc = chfirst to chlast do
	rgcc ! cc = (rgcc ! cc) % (#100000 rshift mark)

// F I L L I N F O N T H
//
and fillinfonth(fun, fa) = valof
[
if mpfnof ! fnfontw eq -1 then
	errhlta(17)
let fd = mpfunfd ! fun
let fdh = lv fd>>FD.fdh
let tsb = lv(fdh>>FDH.rvsbname)
let mpfafunfadef = lv(fdh>>FDH.rvmpfafunfadef)
let ix = vec offasbIxn + 10	
(mpfnof ! fnfontw)>>OF.pos = 0
let fam = nil
	[
	rv ix = gets(fnfontw)
	if ix>>IX.cw gr offasbIxn+10 then errhlta(18)
	for i = 1 to ix>>IX.cw-1 do
		ix ! i = gets(fnfontw)
	if ix>>IX.ty eq tyNil then
		[
		(mpfafunfadef ! fa)<<FUNFA.fun = 0
		(mpfafunfadef ! fa)<<FUNFA.fa = 0
 		resultis false
		]
	if ix>>IX.ty eq tyixn then
		[
		if stcompare(lv ix>>IXN.asb, tsb) eq 0 then
			[
			fam = ix>>IXN.fam
			break
			]
		]
	] repeat
let famfa = (fam lshift 8)+fa
let hMicas = ratio(fdh>>FDH.height, 635, 18)
	[
	rv ix = gets(fnfontw)
	if ix>>IX.cw gr offasbIxn+10 then errhlta(18)
	for i = 1 to ix>>IX.cw-1 do
		ix ! i = gets(fnfontw)
	if ix>>IX.ty eq tyNil then
		[
		(mpfafunfadef ! fa)<<FUNFA.fun = 0
		(mpfafunfadef ! fa)<<FUNFA.fa = 0
 		resultis false
		]
	if ix>>IX.ty eq tyixw then
		[
		if ix>>IXW.famfa eq famfa &
		    (ix>>IXW.hMicas eq hMicas % ix>>IXW.hMicas eq 0) then
			break
		]
	] repeat
let chFirst = ix>>IXW.chFirst
let chLast = ix>>IXW.chLast
(mpfnof ! fnfontw)>>OF.pos = (lv ix>>IXW.apos) ! 1 lshift 1
let tmult = (ix>>IXW.hMicas ? 1, mult(127, fdh>>FDH.height))
let tdiv = (ix>>IXW.hMicas ? 1, 3600); 
let tvpa = nil
tvpa<<VPA.fn = fnscrfs
tvpa<<VPA.fp = ((mpfnof ! fnscrfs)>>OF.macpos) rshift 9
(mpfnof ! fnscrfs)>>OF.macpos = (mpfnof ! fnscrfs)>>OF.macpos+#1000
let trgcc = getvp(tvpa)
let tbp = vbp
lockbp(tbp)
(lv (fdh>>FDH.rvmpfargcc)) ! fa = tvpa
let wtb = ix
for i = 0 to lnwtb-1 do wtb ! i = gets(fnfontw)
let xwFixed = gets(fnfontw)
let xwmax = 0
for ch = 0 to chFirst-1 do
	trgcc ! ch = 0
trgcc ! chFirst = ratio(xwFixed, tmult, tdiv)
for ch = chFirst+1 to chLast do
	[
	let txw = (wtb>>WTB.fXwfixed ? xwFixed, gets(fnfontw))
	trgcc ! ch = ratio((txw eq #100000 ? 0, txw), tmult, tdiv)
	xwmax = umax(xwmax, trgcc ! ch)
	]
for ch = chLast+1 to 255 do
	trgcc ! ch = 0
fdh>>FDH.xwmax = xwmax
markrgcc(trgcc)
unlockbp(tbp, true)
flushvm();
resultis true
]

// I N I T F D H
//
and InitFdh() be
[ for fun = 0 to maxfun-1 do
	[ let fd = mpfunfd ! fun;
	if fd eq fdnil then loop
	for fa = 0 to 3 do
		fillinfonth(fun,fa)
	]
]