// 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