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