{ Font7.inc for graphic screen 7 by Kari Lammassaari 1998 }
{
Needs:
       - msxdos2.inc
       - vdpcmd.inc
       - paintlog.inc
       - loadgrap.inc


With font7.inc you can load several different font types into VRAM and use
them simultaneously in your program. (See fontdemo.com)
Fonts consist from graphic block (*.fn7) , which contains the patterns of ascii
chars 32 - 127 and a 97 byte file (*.ps7) containing the fontheight and char
width for each char. The graphic block contains 32 chars in three rows.
The space between chars is 16 pixels. The height of the block is 3*fontheight.

FONTCONV.COM program converts Dynamic publisher fonts automaticly to *.fn7 and
*.ps7.

REM !!!!!
The font information is stored in dynamic list (pointers),so You MUST begin
your program with line FontRoot := NIL; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

The fonts are referred with fontnumbers. First loaded font is 0, second is 1
and so on .

Available procedures and functions :

 - Procedure LoadFont(FileName:StringType;Y_Coord:Integer;page:Byte);

   Y_coord defines the y-coordinate where to load font block. Used ONLY when
   loading first font. Other fonts are loaded directly to first free
   location .Global variable  FFY:Integer keeps the FirstFreeY-coordinate.
   Page is the graphic page, where to loaf font block. Normally 1 in screen 7

 - Procedure FontWrite(x,y:Integer;page,FontNumber:Byte;St:StringType);

   X,Y  and Page  define the location where the writing occurs.
   FontNumber defines the font to be used ! If there is no font loaded,
   writing request is ignored !
   St contains the string to be qwritten. REM ! No wordwrap ! User must take
   care, that string fits on the screen line !

 - Procedure ChangeFontColor(FontNumber,Color:Byte);

   The Default font color is white (15). Background color is 0.
   Changing the color is done by graphic AND operation, therefore it can be
   done normally  once. To have MULTICOLOURED font, edit font block with
   some graphic editor.

 - Function FontHeight(FontNumber:Byte):Byte;

   Returns the font height of the given font.

 - Function FontCharWidth(FontNumber:Byte;Ch:Char):Byte;

   Returns the width of the given char in given font (proportional spacing)

 - FFY:Integer;

   Contains the first free Y-coordinate after LoadFont-operation.
   Updated by LoadFont. By changing the value of FFY you can create a gap
   between font blocks.

 - FontRoot    :FontPointerType;

   Used by system. The user must set the value of FontRoot to NIL in
   the beginning of the program otherwise errors will occur !
 }


Type FontPointerType = ^FontRecordType;
     FontRecordType = Record
                        Next        :FontPointerType;
                        Y_coordinate:Integer;
                        page        :Byte;
                        FontHeight  :Byte;
                        CharSpacing :Array[0..95] Of Byte;
                      End;

Var FontRoot    :FontPointerType;



Var FFY :Integer;
Procedure LoadFont(FileName:StringType;Y_Coord:Integer;page:Byte);
 Var Buffer :Array[0..95] Of Byte;
     i,c    :Integer;
     Fp,Fp2 :FontPointerType;

 Begin

   New(Fp);Fp^.Next := NIL;
   If FontRoot = NIL Then Begin FontRoot := Fp; FFY := Y_coord; End
    Else
     Begin
      Fp2 := FontRoot;
      While Fp2^.Next <> Nil Do Fp2 := Fp2^.Next;
      Fp2^.Next := Fp;
     End;

   Fp^.Y_Coordinate := FFY;
   Fp^.Page := Page;
   Handle := MsxFileOpen(Copy(Filename,1,Pos('.',Filename)-1)+'.ps7');
   c := 1;
   MsxFileRead(Handle,Addr(Fp^.FontHeight),c);
   c := 96;
   MsxFileRead(Handle,Addr(Fp^.CharSpacing),c);
   MsxFileClose(Handle);
   For c := 0 To 95 Do If Odd(Fp^.CharSpacing[c])
                        Then Fp^.CharSpacing[c] := Fp^.CharSpacing[c]+1;
   LoadGraphicBlock(FileName,0,FFY,Fp^.page,0,0);
   FFY := FFY + 3 * Fp^.FontHeight;
 End;


Procedure ChangeFontColor(FontNumber,Color:Byte);
      Var f,x,y  :Byte;
          fp     :FontPointerType;
  Begin
    If FontRoot = NIL Then Exit;
    Fp := FontRoot;
    f := 0;
    While (Fp^.Next <> NIL) And (f <> FontNumber) Do
     Begin
      f := f+1;
      Fp := Fp^.Next;
     End;
    PaintLog (0,Fp^.y_Coordinate,Fp^.Page,
              512,3*Fp^.FontHeight,
              Color,G_And,0);
  End;


Function FontHeight(FontNumber:Byte):Byte;
      Var f  :Byte;
          fp :FontPointerType;
  Begin
    If FontRoot = NIL Then Begin FontHeight := 0;Exit; End;
    Fp := FontRoot;
    f := 0;
    While (Fp^.Next <> NIL) And (f <> FontNumber) Do
     Begin
      f := f+1;
      Fp := Fp^.Next;
     End;
    FontHeight := Fp^.FontHeight;
 End;

Function FontCharWidth(FontNumber:Byte;Ch:Char):Byte;
      Var f  :Byte;
          fp :FontPointerType;
  Begin
    If FontRoot = NIL Then Begin FontCharWidth := 0;Exit; End;
    Fp := FontRoot;
    f := 0;
    While (Fp^.Next <> NIL) And (f <> FontNumber) Do
     Begin
      f := f+1;
      Fp := Fp^.Next;
     End;
    FontCharWidth := Fp^.CharSpacing[Ord(Ch)-32];
 End;

Procedure FontWrite(x,y:Integer;page,FontNumber:Byte;St:StringType);
   Var fn,i,a,dpage   :Byte;
       ach            :Char Absolute a;
       xx,yy          :Integer;
       fp             :FontPointerType;

  Begin
    If FontRoot = NIL Then Exit;
    fn := FontNumber;
    xx := x;yy := y;
    dpage := page;

    Inline($2a/ FontRoot /$7d/$b4/$28/$14/
           $3a/ fn / $B7/ $28/$0B/
           $47/$4e/ $23/ $66/$69/$7d/$b4/$28/$02/$10/$f6/
           $22/ fp
          );

    For i := 1 To Length(St) Do
      Begin
           ach := St[i];
           Inline(
            $3A/ a /$D6/$20/$32/ a /$F5/$E6/$1F/
            $26/$0/$6F/
            $CB/$25/$CB/$14/$CB/$25/$CB/$14/
            $CB/$25/$CB/$14/$CB/$25/$CB/$14/
            $22/$62/$F5/
            $F1/
            $CB/$3F/$CB/$3F/$CB/$3F/$CB/$3F/$CB/$3F/
            $21/$0/$0/$DD/$2A/ Fp /
            $B7/$28/$9/$47/$16/$0/$DD/$5E/$5/$19/$10/$FD/
            $DD/$5E/$2/$DD/$56/$3/$19/$1E/$0/$DD/$56/$4/$19/$22/$64/$F5/
            $2A/ xx /$22/$66/$F5/$2A/ yy /$3A/ dpage /$57/$19/$22/$68/$F5/
            $DD/$E5/$16/$0/$3A/ a /$5F/$DD/$19/$DD/$5E/$6/
            $ED/$53/$6A/$F5/
            $2a/ xx / $19 / $22 / xx/ {Update xx }
            $DD/$E1/$DD/$5E/$5/$ED/$53/$6C/$F5/$AF/$32/$6F/$F5/$3E/$D0/
            $32/$70/$F5/

            $F3/$3E/$20/$D3/$99/$3E/$11/$F6/$80/$D3/$99/$06/$0F/$0E/$9B/$21/

            $62/$F5/$ED/$B3/$3E/$02/$D3/$99/$3E/$0F/$F6/$80/$D3/$99/$DB/$99/

            $CB/$47/$20/$F0/$AF/$D3/$99/$3E/$8F/$D3/$99
          );
      End;
  End;