// February 17, 1978  1:23 PM				*** "UNDERLAY" ***
//Edited by Lyle Ramshaw September 4, 1980  2:39 PM:
// Added code to set the "isArrows" flag for the Arrows font
 
get "zpDefs.bcpl"

// outgoing procedures:

external [
	MakeFontEntry
	]
  

// outgoing statics:


// incoming procedures:

external [
	MoveBlock			// SYSTEM
	Zero

	equal		// ZPUTIL
	]



// incoming statics:


// local static:


// definitions



let MakeFontEntry(fontName, fontEntry, fontNumber) = valof [MakeFontEntry
	if fontName eq 0 resultis 0
	Zero(fontEntry, FONTDEFlength)
	let nameCount,mode,pointSize,face=0,0,0,0
	for c=1 to fontName>>STRING.length do [
		let char=fontName>>STRING.char↑c
		switchon mode into [
		case 0:
			if char eq $. break
			test char ge $0 & char le $9
			ifso [ mode=1; pointSize=char-$0 ]
			ifnot nameCount=nameCount+1
			endcase
		case 1:
			if char eq $. break
			test char ge $0 & char le $9
			ifso [
				pointSize=10*pointSize+char-$0
				endcase
				]
			ifnot mode=2
		case 2:
			switchon char into [
				case $b:
				case $B: face=face+2; endcase
				case $i:
				case $I: face=face+1; endcase
				default: break
				]
			]
		]
	MoveBlock(fontEntry, fontName, (nameCount/2)+2)
	if nameCount ls FONTDEFnameLength then
		fontEntry>>STRING.char↑(nameCount+1)=0
	fontEntry>>STRING.length=nameCount
	fontEntry>>FONTDEF.face=face
	fontEntry>>FONTDEF.ptSize=pointSize
	fontEntry>>FONTDEF.dispCode= (table [
		#400+$0; #400+$1; #400+$2; #400+$3 ])!fontNumber
	if equal(fontEntry, "LOGO") then
		fontEntry>>FONTDEF.dispCode= #400 + $X
	test equal(fontEntry, "ARROWS") ifso
		[
		fontEntry>>FONTDEF.dispCode= #400 + $Q
		fontEntry>>FONTDEF.isArrows=1
		]
	  ifnot
		fontEntry>>FONTDEF.isArrows=0
	resultis true
	]MakeFontEntry