-- btextfns.mesa
-- last modified by McCreight, December 10, 1982  5:43 PM

DIRECTORY
	AltoFileDefs,
	BitBltDefs,
	multiGraphicsDefs,
	InlineDefs,
	SegmentDefs,
	StreamDefs,
	StringDefs,
	SystemDefs;

TextFns: PROGRAM IMPORTS BitBltDefs, multiGraphicsDefs, InlineDefs, StreamDefs, StringDefs, SegmentDefs, SystemDefs EXPORTS multiGraphicsDefs =
BEGIN OPEN multiGraphicsDefs;

Machine: SegmentDefs.MachineType = SegmentDefs.GetMemoryConfig[].AltoType;
DMachine: BOOLEAN = (Machine = D0) OR (Machine = Dorado);

--stuff for screen font manipulation
TypeLen: TYPE = MACHINE DEPENDENT RECORD
	[type: [0..77B],
	 len: [0..1777B]
	];
FPName: TYPE = MACHINE DEPENDENT RECORD
	[ directory,random,nolog: [0..1],
	  serial1: [0..17777B],
	  serial2: CARDINAL,
	  version: CARDINAL,
	  blank: UNSPECIFIED,
	  leaderDA: AltoFileDefs.vDA,
	  ch: PACKED ARRAY [-1..77B] OF CHARACTER
	];
fontDescriptor: TYPE = RECORD
	[link: POINTER TO fontDescriptor,
	 fp: AltoFileDefs.FP,
	 name: STRING,
	 strikeHandle: POINTER TO StrikeFont
	];
fontListHandle: POINTER TO fontDescriptor _ ReadALFonts[];
SelfRelative: TYPE = SelfRelativeBase RELATIVE POINTER TO ALChar;
SelfRelativeBase: TYPE = BASE POINTER TO SelfRelative;
ALFontHead: TYPE = RECORD
	[height: CARDINAL,
	 proportional: [0..1],
	 baseline: [0..177B],
	 maxWidth: [0..377B],
	 Pointers: ARRAY [0..377B] OF SelfRelative
	];
ALChar: TYPE = RECORD
	[XW: CARDINAL,
	 HD: [0..377B],
	 XH: [0..377B]
	];
ALCharHandle: TYPE = BASE POINTER TO ALChar;
RelativeBitmapPointer: TYPE = ALCharHandle RELATIVE POINTER TO ARRAY OF CARDINAL;
xx: ARRAY [0..SIZE[BitBltDefs.BBTable]] OF UNSPECIFIED;
textBLT: POINTER TO BitBltDefs.BBTable _
	@xx[LOOPHOLE[@xx,CARDINAL] MOD 2];

Allocate: PROCEDURE [nwords: CARDINAL] RETURNS [LONG POINTER];
Free: PROCEDURE [LONG POINTER];
AllocateFromBank: PROCEDURE [nwords: CARDINAL,bank: CARDINAL] RETURNS [LONG POINTER];

SetText: PUBLIC PROCEDURE [s: STRING,x,y: INTEGER,fn: BitBltDefs.BBoperation,font: POINTER TO StrikeFont,mode: textMode,strt:CARDINAL_0,end:CARDINAL_0,
b: POINTER TO Bitmap _ NIL]  RETURNS [nextX: INTEGER] =
BEGIN
i: CARDINAL;
width: CARDINAL;
IF b = NIL THEN b _ GetDefaultBitmapHandle[];

nextX _ x;
IF end=0 THEN end_s.length;
IF y+INTEGER[font.descent] < 0 THEN RETURN[nextX];
y _ y - font.ascent -1;	--the (x,y) coordinate refers to the baseline
IF y > INTEGER[b.nLines] THEN RETURN[nextX];

textBLT.function _ fn;
textBLT.dlbca _ MakeLongPointer[b.bits,b.bank];
textBLT.dbca _ b.bits;
textBLT.dbmr _ b.nWords;
textBLT.sty _ textBLT.dw _ textBLT.dh _ 0;
textBLT.slbca _ MakeLongPointer[font.bitmap,font.bank];
textBLT.sbca _ font.bitmap;
textBLT.sbmr _ font.wordsPerScanLine;

SELECT mode FROM
normal, bold =>
	BEGIN
	textBLT.dh _ MIN[font.ascent+font.descent,MAX[0,INTEGER[b.nLines-y]]];
	IF INTEGER[y] < 0 THEN
		BEGIN
		textBLT.dh _ textBLT.dh + y;
		IF INTEGER[textBLT.dh] < 0 THEN RETURN[nextX];
		textBLT.sty _ textBLT.sty - y;
		y_0;
		END;
	FOR i IN [strt..end) DO
		IF INTEGER[nextX] >= INTEGER[b.nBits] THEN RETURN[nextX];
		textBLT.dlx _ nextX;
		textBLT.dty _ y;
		width _ MIN[font.xInSegment[LOOPHOLE[s[i],CARDINAL]+1] -
				 font.xInSegment[LOOPHOLE[s[i],CARDINAL]],
					MAX[0,INTEGER[b.nBits-nextX]]];
		textBLT.dw _ width;
		textBLT.slx _ font.xInSegment[LOOPHOLE[s[i],CARDINAL]];
		IF INTEGER[nextX] < 0 THEN
			BEGIN
			textBLT.dw _ MAX[0,INTEGER[textBLT.dw+nextX]];
			textBLT.slx _ textBLT.slx - nextX;
			textBLT.dlx _ 0;
			END;
		BitBltDefs.BITBLT[textBLT];
		IF mode = bold THEN
			BEGIN 
			textBLT.dlx _ textBLT.dlx+1;
			textBLT.dw _ MIN[textBLT.dw,MAX[0,INTEGER[b.nBits-nextX]]];
			BitBltDefs.BITBLT[textBLT];
		 	END;
		nextX _ nextX + width;
	ENDLOOP;
	END; -- case normal
italic, bold+italic =>
	BEGIN
	yStep: CARDINAL = 4; 
	numYSteps: CARDINAL = (font.ascent+font.descent+yStep-1)/yStep;
	firstStep: CARDINAL _ font.ascent+font.descent - (numYSteps-1)*yStep;
	iMin: INTEGER = -((numYSteps-1)/2);
	iMax: INTEGER = numYSteps/2;
	italicStep: INTEGER;
	FOR i IN [strt..end) DO
		IF INTEGER[nextX] >= INTEGER[b.nBits] THEN RETURN[nextX];
		textBLT.dty _ y;
		width _ MIN[font.xInSegment[LOOPHOLE[s[i],CARDINAL]+1] -
				font.xInSegment[LOOPHOLE[s[i],CARDINAL]],
					MAX[0,INTEGER[b.nBits-nextX]]];
		textBLT.dw _ width;
		textBLT.slx _ font.xInSegment[LOOPHOLE[s[i],CARDINAL]];
		textBLT.sty _ 0;
		textBLT.dh _ MIN[MAX[0,INTEGER[b.nLines-y]],firstStep];
		FOR italicStep DECREASING IN [iMin..iMax] DO
			textBLT.dlx _ nextX + italicStep;
			textBLT.dw _ MIN[textBLT.dw,MAX[0,INTEGER[b.nBits-textBLT.dlx]]];
			IF INTEGER[textBLT.dlx] < 0 THEN
				BEGIN
				textBLT.dw _ MAX[0,INTEGER[textBLT.dw+textBLT.dlx]];
				textBLT.slx _ textBLT.slx - textBLT.dlx;
				textBLT.dlx _ 0;
				END;
			IF INTEGER[textBLT.dty + textBLT.dh] > 0 THEN
				BEGIN
				IF INTEGER[textBLT.dty] < 0 THEN
					BEGIN
					textBLT.sty _ textBLT.sty - textBLT.dty;
					textBLT.dh _ textBLT.dh + textBLT.dty;
					textBLT.dty _ 0;
					END;
				BitBltDefs.BITBLT[textBLT];
				IF mode = bold+italic THEN
					BEGIN
					textBLT.dlx _ textBLT.dlx+1;
					textBLT.dw _ MIN[textBLT.dw,MAX[0,INTEGER[b.nBits-textBLT.dlx]]];
					BitBltDefs.BITBLT[textBLT];
					END;
				END;
			textBLT.sty _ textBLT.sty + textBLT.dh;
			textBLT.dty _ textBLT.dty + textBLT.dh;
			textBLT.dh _ MIN[MAX[0,INTEGER[b.nLines-textBLT.dty]],yStep];
		ENDLOOP;
		nextX _ nextX + width;
	ENDLOOP;
	END;	--end of italic case
ENDCASE;
END;

SetStrong: PUBLIC PROCEDURE [so: LONG POINTER,x,y: INTEGER,fn: BitBltDefs.BBoperation,font: POINTER TO StrikeFont,mode: textMode,strt:CARDINAL_0,end:CARDINAL_0,
b: POINTER TO Bitmap _ NIL]  RETURNS [nextX: INTEGER] =
BEGIN
s:LONG POINTER TO StringBody = so;
i: CARDINAL;
width: CARDINAL;
IF b = NIL THEN b _ GetDefaultBitmapHandle[];

nextX _ x;
IF end=0 THEN end_s.length;
IF y+INTEGER[font.descent] < 0 THEN RETURN[nextX];
y _ y - font.ascent -1;	--the (x,y) coordinate refers to the baseline
IF y > INTEGER[b.nLines] THEN RETURN[nextX];

textBLT.function _ fn;
textBLT.dlbca _ MakeLongPointer[b.bits,b.bank];
textBLT.dbca _ b.bits;
textBLT.dbmr _ b.nWords;
textBLT.sty _ textBLT.dw _ textBLT.dh _ 0;
textBLT.slbca _ MakeLongPointer[font.bitmap,font.bank];
textBLT.sbca _ font.bitmap;
textBLT.sbmr _ font.wordsPerScanLine;

SELECT mode FROM
normal, bold =>
	BEGIN
	textBLT.dh _ MIN[font.ascent+font.descent,MAX[0,INTEGER[b.nLines-y]]];
	IF INTEGER[y] < 0 THEN
		BEGIN
		textBLT.dh _ textBLT.dh + y;
		IF INTEGER[textBLT.dh] < 0 THEN RETURN[nextX];
		textBLT.sty _ textBLT.sty - y;
		y_0;
		END;
	FOR i IN [strt..end) DO
		IF INTEGER[nextX] >= INTEGER[b.nBits] THEN RETURN[nextX];
		textBLT.dlx _ nextX;
		textBLT.dty _ y;
		width _ MIN[font.xInSegment[LOOPHOLE[s[i],CARDINAL]+1] -
				 font.xInSegment[LOOPHOLE[s[i],CARDINAL]],
					MAX[0,INTEGER[b.nBits-nextX]]];
		textBLT.dw _ width;
		textBLT.slx _ font.xInSegment[LOOPHOLE[s[i],CARDINAL]];
		IF INTEGER[nextX] < 0 THEN
			BEGIN
			textBLT.dw _ MAX[0,INTEGER[textBLT.dw+nextX]];
			textBLT.slx _ textBLT.slx - nextX;
			textBLT.dlx _ 0;
			END;
		BitBltDefs.BITBLT[textBLT];
		IF mode = bold THEN
			BEGIN 
			textBLT.dlx _ textBLT.dlx+1;
			textBLT.dw _ MIN[textBLT.dw,MAX[0,INTEGER[b.nBits-nextX]]];
			BitBltDefs.BITBLT[textBLT];
		 	END;
		nextX _ nextX + width;
	ENDLOOP;
	END; -- case normal
italic, bold+italic =>
	BEGIN
	yStep: CARDINAL = 4; 
	numYSteps: CARDINAL = (font.ascent+font.descent+yStep-1)/yStep;
	firstStep: CARDINAL _ font.ascent+font.descent - (numYSteps-1)*yStep;
	iMin: INTEGER = -((numYSteps-1)/2);
	iMax: INTEGER = numYSteps/2;
	italicStep: INTEGER;
	FOR i IN [strt..end) DO
		IF INTEGER[nextX] >= INTEGER[b.nBits] THEN RETURN[nextX];
		textBLT.dty _ y;
		width _ MIN[font.xInSegment[LOOPHOLE[s[i],CARDINAL]+1] -
				font.xInSegment[LOOPHOLE[s[i],CARDINAL]],
					MAX[0,INTEGER[b.nBits-nextX]]];
		textBLT.dw _ width;
		textBLT.slx _ font.xInSegment[LOOPHOLE[s[i],CARDINAL]];
		textBLT.sty _ 0;
		textBLT.dh _ MIN[MAX[0,INTEGER[b.nLines-y]],firstStep];
		FOR italicStep DECREASING IN [iMin..iMax] DO
			textBLT.dlx _ nextX + italicStep;
			textBLT.dw _ MIN[textBLT.dw,MAX[0,INTEGER[b.nBits-textBLT.dlx]]];
			IF INTEGER[textBLT.dlx] < 0 THEN
				BEGIN
				textBLT.dw _ MAX[0,INTEGER[textBLT.dw+textBLT.dlx]];
				textBLT.slx _ textBLT.slx - textBLT.dlx;
				textBLT.dlx _ 0;
				END;
			IF INTEGER[textBLT.dty + textBLT.dh] > 0 THEN
				BEGIN
				IF INTEGER[textBLT.dty] < 0 THEN
					BEGIN
					textBLT.sty _ textBLT.sty - textBLT.dty;
					textBLT.dh _ textBLT.dh + textBLT.dty;
					textBLT.dty _ 0;
					END;
				BitBltDefs.BITBLT[textBLT];
				IF mode = bold+italic THEN
					BEGIN
					textBLT.dlx _ textBLT.dlx+1;
					textBLT.dw _ MIN[textBLT.dw,MAX[0,INTEGER[b.nBits-textBLT.dlx]]];
					BitBltDefs.BITBLT[textBLT];
					END;
				END;
			textBLT.sty _ textBLT.sty + textBLT.dh;
			textBLT.dty _ textBLT.dty + textBLT.dh;
			textBLT.dh _ MIN[MAX[0,INTEGER[b.nLines-textBLT.dty]],yStep];
		ENDLOOP;
		nextX _ nextX + width;
	ENDLOOP;
	END;	--end of italic case
ENDCASE;
END;

MeasureText: PUBLIC PROCEDURE [s: STRING,font: POINTER TO StrikeFont,b: POINTER TO Bitmap _ NIL]  RETURNS [nextX: INTEGER] =
BEGIN
i: CARDINAL;
width: CARDINAL;
IF b = NIL THEN b _ GetDefaultBitmapHandle[];

nextX _ 0;

	FOR i IN [0..s.length) DO
		width _ font.xInSegment[LOOPHOLE[s[i],CARDINAL]+1] -
				 font.xInSegment[LOOPHOLE[s[i],CARDINAL]];
		nextX _ nextX + width;
	ENDLOOP;
END;

CharWidth:PUBLIC PROCEDURE[c:CHARACTER,font:POINTER TO
	StrikeFont]  RETURNS [INTEGER] =
BEGIN
		RETURN[font.xInSegment[LOOPHOLE[c,CARDINAL]+1] -
				 font.xInSegment[LOOPHOLE[c,CARDINAL]]];
END;

GetStrikeHandle: PUBLIC PROCEDURE [fontName: STRING] RETURNS [POINTER TO StrikeFont] =
BEGIN
fileList: POINTER TO fontDescriptor _ fontListHandle;
UNTIL fileList = NIL DO
	IF StringDefs.EquivalentString[fileList.name,fontName] THEN
	BEGIN
		IF fileList.strikeHandle = NIL THEN fileList^.strikeHandle _ ALtoStrike[@fileList.fp];
		RETURN[fileList.strikeHandle];
	END;
	fileList _ fileList.link;
ENDLOOP;
RETURN[NIL];
END;
(635)\201b7B168b134B1055b2B54b7B71b8B55b4B28b16B70b8B3514b9B3556b11B379b9B187b16B
GetFontNameArray: PROCEDURE RETURNS [POINTER TO ARRAY [0..0) OF STRING,CARDINAL] =
BEGIN
i: CARDINAL _ 0;
p: POINTER TO ARRAY [0..0) OF STRING;
fileList: POINTER TO fontDescriptor _ fontListHandle;
UNTIL fileList = NIL DO
	i_i+1;
	fileList _ fileList.link;
ENDLOOP;
p _ SystemDefs.AllocateHeapNode[i];
i_0;
fileList _ fontListHandle;
UNTIL fileList = NIL DO
	p[i] _ fileList.name;
	i_i+1;
	fileList _ fileList.link;
ENDLOOP;
RETURN[p,i];
END;

ReadALFonts: PROCEDURE RETURNS [fontDescriptorHandle: POINTER TO fontDescriptor] =
BEGIN
DVHead: TypeLen;
DVBody: FPName;
name: STRING _ [100];
ext: STRING _ [100];
newString: STRING;
firstLinkPointer: POINTER TO fontDescriptor _ NIL;
linkPointer: POINTER TO UNSPECIFIED _ @firstLinkPointer;
i: CARDINAL;
BCPLLen: CARDINAL;
mem: POINTER TO fontDescriptor;
S: StreamDefs.DiskHandle _ StreamDefs.NewWordStream["sysdir",StreamDefs.Read];
S.reset[S];

UNTIL S.endof[S] DO
	DVHead_S.get[S];
	[] _ StreamDefs.ReadBlock[S,@DVBody,MIN[SIZE[FPName],DVHead.len-1]];
	FOR i IN [SIZE[FPName]..DVHead.len-1) DO [] _ S.get[S];ENDLOOP;
	IF DVHead.type = 1 THEN	--its a file
		BEGIN
		name.length_ext.length_0;
		BCPLLen _ LOOPHOLE[DVBody.ch[-1],CARDINAL];
		FOR i IN [0..BCPLLen) DO
			IF DVBody.ch[i] = '. THEN EXIT;
			IF DVBody.ch[i] = '! THEN EXIT;	--strip version
			StringDefs.AppendChar[name,DVBody.ch[i]];
		ENDLOOP;
		IF DVBody.ch[i]='. THEN	--grab 
		FOR i IN [name.length+1..BCPLLen) DO
			IF DVBody.ch[i] = '. THEN EXIT;
			IF DVBody.ch[i] = '! THEN EXIT;	--strip version
			StringDefs.AppendChar[ext,DVBody.ch[i]];
		ENDLOOP;
		IF NOT StringDefs.EquivalentString["AL",ext] THEN LOOP;	--not me
		mem _ SystemDefs.AllocateHeapNode[SIZE[fontDescriptor]];
		newString _ SystemDefs.AllocateHeapString[name.length];
		mem^.link_NIL;
		mem^.fp.serial.bits.directory _ DVBody.directory;
		mem^.fp.serial.bits.random _ DVBody.random;
		mem^.fp.serial.bits.nolog _ DVBody.nolog;
		mem^.fp.serial.part1 _ DVBody.serial1;
		mem^.fp.serial.part2 _ DVBody.serial2;
		mem^.fp.leaderDA _ DVBody.leaderDA;
		mem^.name _ newString;
		mem^.strikeHandle _ NIL;
		newString.length _ 0;
		StringDefs.AppendString[newString,name];
		linkPointer^ _ mem;
		linkPointer _ mem;
		END;
ENDLOOP;
S.destroy[S];
RETURN[firstLinkPointer];
END;

ALtoStrike:  PROCEDURE [fp: POINTER TO AltoFileDefs.FP] RETURNS [POINTER TO StrikeFont] =
BEGIN
i: CARDINAL;
strikeWidth: CARDINAL _ 0;
currentWidth: CARDINAL;
strikeWidthMax: CARDINAL _ 0;
ALFileHandle: SegmentDefs.FileHandle _ SegmentDefs.InsertFile[fp,SegmentDefs.Read];
ALSegment: SegmentDefs.FileSegmentHandle _
	SegmentDefs.NewFileSegment[ALFileHandle,SegmentDefs.DefaultBase,	
		SegmentDefs.DefaultPages,SegmentDefs.Read];
--array big enough for 18 point fonts
ALData: POINTER TO ALFontHead; 
XHData: ALCharHandle;
sf: POINTER TO StrikeFont;
srbase: SelfRelativeBase;
strikeIndexLen: CARDINAL = 256;
xIndex: POINTER TO ARRAY [0..strikeIndexLen) OF CARDINAL _
									SystemDefs.AllocateHeapNode[strikeIndexLen];
x: ARRAY [0..SIZE[BitBltDefs.BBTable]] OF UNSPECIFIED;
BLT: POINTER TO BitBltDefs.BBTable _
	@x[LOOPHOLE[@x,CARDINAL] MOD 2];

SegmentDefs.SwapIn[ALSegment];
ALData _ SegmentDefs.FileSegmentAddress[ALSegment];

--calculate width of strike raster
FOR i IN [0..377B] DO
	xIndex[i] _ strikeWidth;
	srbase _ @ALData.Pointers[i];
	XHData _ @srbase[srbase^];
	currentWidth_0;
	UNTIL InlineDefs.BITAND[XHData.XW,1] = 1 DO	--Read extension characters
		currentWidth _ currentWidth+16;
		srbase _ @ALData.Pointers[XHData.XW/2];
		XHData _ @srbase[srbase^];
	ENDLOOP;
	currentWidth _ currentWidth + XHData.XW/2;
	strikeWidth _ strikeWidth + currentWidth;
	IF currentWidth > strikeWidthMax THEN strikeWidthMax _ currentWidth;
ENDLOOP;
xIndex[377B] _ strikeWidth;

sf _ SystemDefs.AllocateHeapNode[SIZE[StrikeFont]];
sf^ _ [oneBit: 1,bank: ,index: 0,fixed: 1-ALData^.proportional,
	minCode: 0,maxCode: strikeIndexLen-1,maxWidth: strikeWidthMax,
	strikeBodyWordLength: ((strikeWidth+15)/16)*ALData^.height,
	ascent: ALData^.baseline,descent: ALData^.height - ALData^.baseline,
	wordsPerScanLine: ((strikeWidth+15)/16),bitmap: NIL,xInSegment: LOOPHOLE[xIndex]];
BLT^ _ [ptrs: IF DMachine THEN long ELSE short,pad: 0,sourcealt: FALSE,destalt: FALSE,sourcetype: block,
		function: replace,unused: 0,dbca: NIL,dbmr: sf.wordsPerScanLine,dlx: 0,dty: 0,
		dw: strikeWidth,dh: sf.ascent+sf.descent,sbca: NIL,sbmr: 1,slx: 0,sty: 0,
		gray0: 0,gray1: 0,gray2: 0,gray3: 0,dlbca:,slbca:];

[Allocate,Free,AllocateFromBank] _ GetXMAlloc[];
BLT.dlbca _ Allocate[sf.strikeBodyWordLength];
sf.bank _ InlineDefs.HighHalf[BLT.dlbca];
sf.bitmap _ InlineDefs.LowHalf[BLT.dlbca];
BLT.dbca _ sf.bitmap;
BLT.sourcetype_gray;BitBltDefs.BITBLT[BLT]; --erase area
BLT.sourcetype _ block;


--now, slam in all the characters
FOR i IN [0..377B] DO
	BEGIN
	offset: RelativeBitmapPointer;
	srbase _ @ALData.Pointers[i];
	XHData _ @srbase[srbase^];
	BLT.dlx _ xIndex[i];
	BLT.dty _ XHData.HD;
	BLT.dh _ XHData.XH;
	offset _ LOOPHOLE[-XHData.XH];
	BLT.slbca _ @XHData[offset];
	BLT.sbca _ InlineDefs.LowHalf[BLT.slbca];
	UNTIL InlineDefs.BITAND[XHData.XW,1] = 1 DO 
		BLT.dw _ 16;
		BitBltDefs.BITBLT[BLT];
		srbase _ @ALData.Pointers[XHData.XW/2];
		XHData _ @srbase[srbase^];
		BLT.dlx _ BLT.dlx + 16;
		BLT.dty _ XHData.HD;
		BLT.dh _ XHData.XH;
		offset _ LOOPHOLE[-XHData.XH];
		BLT.slbca _ @XHData[offset];
		BLT.sbca _ InlineDefs.LowHalf[BLT.slbca];
	ENDLOOP;
	BLT.dw _ XHData.XW/2;
	BitBltDefs.BITBLT[BLT];

	END;
ENDLOOP;

SegmentDefs.Unlock[ALSegment];
SegmentDefs.DeleteFileSegment[ALSegment];

RETURN[sf];
END;
\b16B428b11B1800b10B
--initialization of textBLT
textBLT^ _ [ptrs: IF DMachine THEN long ELSE short,pad: 0,sourcealt: FALSE,destalt: FALSE,
	sourcetype: block,function: ,unused: 0,dbca: NIL,dbmr: ,dlx: ,dty: ,dw: 0,dh: 0,
	sbca: NIL,sbmr: ,slx: ,sty: 0,gray0: ,gray1: ,gray2: ,gray3: ,slbca: ,dlbca: ];
END.