-- TSBcplFontFileImpl.mesa
-- Modified by Geschke on November 6, 1979 10:31 AM
-- Changed by Maureen Stone, 30-Dec-81 17:14:57
-- Changed by Michael Plass, June 24, 1982 3:25 pm
DIRECTORY
TSBcplFontFile,
RealConvert USING [BcplToIeee],
Mopcodes,
IO,
Rope,
Heap;
TSBcplFontFileImpl: PROGRAM
IMPORTS TSBcplFontFile, RealConvert,
Heap, IO
EXPORTS TSBcplFontFile =
BEGIN OPEN TSBcplFontFile, IO;
ROPE: TYPE = Rope.ROPE;
BcplToMesaReal: PROCEDURE[b: BcplREAL] RETURNS[REAL] = INLINE
BEGIN RETURN[RealConvert.BcplToIeee[LOOPHOLE[b]]] END;
Allocate: PROC[nwords: INTEGER] RETURNS[LONG POINTER] = {RETURN[Heap.MakeNode[Heap.systemZone,nwords]]};
Free: PROC[p: LONG POINTER] = {Heap.FreeNode[Heap.systemZone,p]};
Stream: TYPE = IO.STREAM;
StreamIndex: TYPE = INT;
inStream: Stream ← NIL;
inSDname: LONG POINTER TO name RawIndex;
inSDsplines: LONG POINTER TO splines RawIndex;
inSDfontname: LONG STRING;
inBaseIndex: StreamIndex;
mesaSplineData: mesaSplineDataDesc;
mesaSplineDir: mesaSplineDirDesc;
OpenSDFontFile: PUBLIC PROCEDURE [file: ROPE] =
BEGIN
c: CHARACTER;
inSDend: LONG POINTER TO end RawIndex;
inSplineData: SplineDataDesc;
inSplineDir: SplineDirDesc;
nChars: CARDINAL;
IF inStream # NIL THEN ERROR;
inStream ← IO.CreateFileStream[file, read];
inSDname ← GetRawIndex[];
IF inSDname.hdr.type # name THEN ERROR;
inSDfontname ← BcplToMesaString[inSDname.fontname];
inSDsplines ← GetRawIndex[];
IF inSDsplines.hdr.type # splines OR
inSDsplines.rotation # 0 THEN ERROR;
inSDend ← GetRawIndex[];
IF inSDend.hdr.type # end THEN ERROR;
Free[inSDend];
nChars ← inSDsplines.ec-inSDsplines.bc+1; --number of characters in this font
--read in the character information (bounding boxes, etc.)
inSplineData ← DESCRIPTOR[Allocate[nChars*SIZE[BcplSplineData]],nChars];
IO.SetIndex[
inStream,
LongPointerToStreamIndex[BcplToMesaLongPointer[inSDsplines.startaddress]]];
ReadBlock[inStream,BASE[inSplineData],nChars*SIZE[BcplSplineData]];
mesaSplineData ← LOOPHOLE[inSplineData];
inBaseIndex←IO.GetIndex[inStream]; --the directory addresses are relative to this point
--read in the directory information (pointers to actual spline information)
inSplineDir ← DESCRIPTOR[Allocate[nChars*SIZE[bcplLONGPOINTER]],nChars];
ReadBlock[inStream,BASE[inSplineDir],nChars*SIZE[bcplLONGPOINTER]];
mesaSplineDir ← LOOPHOLE[inSplineDir];
-- convert BCPL dir and spline data to Mesa
FOR c IN [inSDsplines.bc..inSDsplines.ec] DO
IF inSplineDir[c-inSDsplines.bc] = --set the unused entries to NIL and LOOP
LOOPHOLE[LOOPHOLE[LONG[-1], LONG INTEGER], bcplLONGPOINTER] THEN
BEGIN mesaSplineDir[c-inSDsplines.bc] ← NIL; LOOP END;
mesaSplineDir[c-inSDsplines.bc] ← BcplToMesaLongPointer[inSplineDir[c-inSDsplines.bc]];
BEGIN
bcplData: LONG POINTER TO BcplSplineData ← @inSplineData[c-inSDsplines.bc];
mesaData: LONG POINTER TO SplineData ← @mesaSplineData[c-inSDsplines.bc];
mesaData.xwidth ← BcplToMesaReal[bcplData.xwidth];
mesaData.ywidth ← BcplToMesaReal[bcplData.ywidth];
mesaData.bbox ← BcplToMesaReal[bcplData.bbox];
mesaData.bboy ← BcplToMesaReal[bcplData.bboy];
mesaData.rightx ← BcplToMesaReal[bcplData.rightx];
mesaData.topy ← BcplToMesaReal[bcplData.topy];
END;
ENDLOOP;
-- at this point we are prepared to read splines from the SD file
RETURN
END;
CloseSDFontFile: PUBLIC PROCEDURE =
BEGIN
IO.Close[inStream];
inStream ← NIL;
Free[inSDname];
Free[inSDsplines];
Free[BASE[mesaSplineData]];
Free[BASE[mesaSplineDir]];
END;
GetRawIndex: PROCEDURE RETURNS [LONG POINTER] =
BEGIN
p: LONG POINTER TO RawIndex;
p← Allocate[SIZE[RawIndex]];
ReadBlock[inStream,p,SIZE[IndexHeader]];
ReadBlock[inStream,p+SIZE[IndexHeader],p.hdr.length-1];
RETURN[p];
END;
GetSplineCommands: PUBLIC PROCEDURE[char: CHARACTER, userAlloc: AllocProc]
RETURNS [sd: SplineDataPtr, scp: SplineCommandPtr] =
BEGIN
index: StreamIndex;
last: SplineCommandPtr;
IF char-inSDsplines.bc NOT IN[0..LENGTH[mesaSplineDir])
OR mesaSplineDir[char-inSDsplines.bc] = NIL THEN RETURN[NIL, NIL];
sd ← @mesaSplineData[char-inSDsplines.bc];
index ← LongPointerToStreamIndex[StreamIndexToLongCardinal[inBaseIndex]+mesaSplineDir[char-inSDsplines.bc]];
IO.SetIndex[inStream, index];
[scp,index] ← GetNextCommand[index, userAlloc];
last ← scp;
DO
[last.next,index] ← GetNextCommand[index, userAlloc];
IF last.next.type = EndDefinition THEN EXIT;
last ← last.next;
ENDLOOP;
RETURN
END;
GetNextCommand: PROCEDURE[index: StreamIndex, userAlloc: AllocProc]
RETURNS [SplineCommandPtr, StreamIndex] =
BEGIN
bsc: BcplSplineCommand; --machine dependent record
scc: SplineCommandCode;
scp: SplineCommandPtr;
IO.SetIndex[inStream, index];
scc ← BcplToMesaCommandCode[bsc.type ← GetWord[inStream]];
ReadBlock[
inStream, @bsc+1, --it's really ok
(SELECT scc FROM
MoveTo, DrawTo => SIZE[MoveTo BcplSplineCommand],
DrawCurve => SIZE[DrawCurve BcplSplineCommand],
ENDCASE => SIZE[EndDefinition BcplSplineCommand])-1];
scp ← userAlloc[SELECT scc FROM
MoveTo, DrawTo => SIZE[MoveTo SplineCommand],
DrawCurve => SIZE[DrawCurve SplineCommand],
ENDCASE => SIZE[EndDefinition SplineCommand]];
SELECT scc FROM
MoveTo => scp↑ ← [, MoveTo[,]];
DrawTo => scp↑ ← [, DrawTo[,]];
DrawCurve => scp↑ ← [, DrawCurve[,,,,,]];
NewObject => scp↑ ← [, NewObject[]];
EndDefinition => scp↑ ← [, EndDefinition[]];
ENDCASE;
scp.next ← NIL;
WITH scp SELECT FROM
MoveTo, DrawTo =>
BEGIN
x ← BcplToMesaReal[bsc.x];
y ← BcplToMesaReal[bsc.y];
END;
DrawCurve =>
BEGIN
x0 ← BcplToMesaReal[bsc.x0];
y0 ← BcplToMesaReal[bsc.y0];
x1 ← BcplToMesaReal[bsc.x1];
y1 ← BcplToMesaReal[bsc.y1];
x2 ← BcplToMesaReal[bsc.x2];
y2 ← BcplToMesaReal[bsc.y2];
END;
ENDCASE;
RETURN[scp, IO.GetIndex[inStream]]
END;
BcplToMesaCommandCode: PROCEDURE[bcc: BcplCommandCode] RETURNS [SplineCommandCode] =
BEGIN
SELECT bcc FROM
1 => RETURN[MoveTo];
2 => RETURN[DrawTo];
3 => RETURN[DrawCurve];
-1 => RETURN[NewObject];
-2 => RETURN[EndDefinition];
ENDCASE => ERROR
END;
LongPointerToStreamIndex: PROCEDURE [l: LONG POINTER] RETURNS [StreamIndex]=
BEGIN
RETURN[2*LOOPHOLE[l,INT]];
END;
StreamIndexToLongCardinal: PROCEDURE [s:StreamIndex] RETURNS [LONG CARDINAL]=
BEGIN
RETURN[s/2];
END;
BcplToMesaString: PROCEDURE [t: BcplSTRING] RETURNS[s: LONG STRING] = {
len: INTEGER ← LOOPHOLE[t[0]]; --one byte of length
IF len NOT IN[0..255] THEN ERROR;
s ← Heap.MakeString[Heap.systemZone,len];
FOR i: INTEGER IN [0..len) DO s[i] ← t.body[i+1]; ENDLOOP;
};
ReadBlock: PROC[stream: Stream, p: LONG POINTER, nwords: INT] = {
block: IO.UnsafeBlock ← [base: p, startIndex: 0, stopIndexPlusOne: 2*nwords];
[] ← IO.UnsafeGetBlock[stream,block];
};
GetWord: PROC[stream: Stream] RETURNS [INTEGER] = {
word: INTEGER;
foo: LONG POINTER TO INTEGER ← @word;
block: IO.UnsafeBlock ← [base: foo, startIndex: 0, stopIndexPlusOne: 2];
[] ← IO.UnsafeGetBlock[stream,block];
RETURN[word];
};
END.
-- Changed by Maureen Stone, 30-Dec-81 17:14:57 to convert to Cedar 2.2
-- Changed by Michael Plass, May 27, 1982 8:35 am. IOStream => IO, file name LONG STRING => ROPE.
-- Changed by Michael Plass, June 24, 1982 3:25 pm. Cedar 3.2 conversion.