home *** CD-ROM | disk | FTP | other *** search
/ PC go! 1995 September / Image.iso / pcgo / programm / online / mediaplx / terminat / pascal / showfont.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-03-11  |  3.0 KB  |  118 lines
  1. Program ShowFont;
  2.  
  3. {
  4.   Example for loading and showing a font for Terminate.
  5.          By Bo Bendtsen and Bjarne Duelund 1994
  6.                 Free to use or modify
  7.  
  8.   Font format:
  9.  
  10.                        msb              lsb
  11.   SmallFont:    'A'      |1.byte||2.byte|
  12.                          000011111100----
  13.                          001100000011----
  14.                          001100000011----
  15.                          001100000011----
  16.                          001111111111----
  17.                          001100000011----
  18.                          001100000011----
  19.                          000000000000----
  20.  
  21.                        msb                      lsb
  22.   LargeFont:    'A'      |1.byte||2.byte||3.byte|
  23.                          00000000000000000000----
  24.                          00000000000000000000----
  25.                          00000000000000000000----
  26.                          00001111110000000000----
  27.                          00000000110000000000----
  28.                          00000001111000000000----
  29.                          00000011001100000000----
  30.                          00000110000110000000----
  31.                          00001100000011000000----
  32.                          00011111111111100000----
  33.                          00110000000000110000----
  34.                          01100000000000011000----
  35.                          11110000000000111100----
  36.                          00000000000000000000----
  37.                          00000000000000000000----
  38.                          00000000000000000000----
  39. }
  40.  
  41. Type
  42.   FontType = Record
  43.       { 12 pixel x  8 lines, 2 bytes/line }
  44.       SmallFont :Array[0..255] of Array[0..15] of Byte;
  45.       { 20 pixel x 16 lines, 3 bytes/line }
  46.       LargeFont :Array[0..255] of Array[0..47] of Byte;
  47.   End;
  48.  
  49. Var
  50.   Font      : FontType;
  51.   FontFile  : File of FontType;
  52.   f,x,y,z,p : Word;
  53.  
  54. Begin
  55.   If Paramcount<>1 Then
  56.   Begin
  57.     WriteLn('Syntax: SHOWFONT fontname');
  58.     Halt;
  59.   End;
  60.   Assign(FontFile,Paramstr(1));
  61.   {$I-} Reset(FontFile); {$I+}
  62.   If IOResult<>0 Then
  63.   Begin
  64.     WriteLn('Could not open '+Paramstr(1));
  65.     Halt;
  66.   End;
  67.   Read(FontFile,Font);
  68.   Close(FontFile);
  69.  
  70.   Asm { 640x480x2 mono vga }
  71.     Mov ah,0
  72.     Mov al,$11
  73.     Int $10
  74.   End;
  75.  
  76.   Writeln('Small font'#10#10#10#10#10#10#10#10#10#13'Large font'+
  77.           #10#10#10#10#10#10#10#10#10#10#10#10#10#10#10#10#10);
  78.  
  79.   { Show small font }
  80.   f:=0;
  81.   For z:=0 to 7 Do
  82.   Begin
  83.     For x:=0 to 31 Do
  84.       For y:=0 to 15 Do
  85.       Begin
  86.         Move(Font.SmallFont[f+x][y],Mem[$A000:(y*40)+1600+(x*2)+(z*1200)],2);
  87.         Inc(y);
  88.       End;
  89.     Inc(f,32);
  90.   End;
  91.  
  92.   { Show large font }
  93.   f:=0;
  94.   For p:=0 To 15 Do
  95.   Begin
  96.     For x:=0 to 15 Do
  97.     Begin
  98.       z:=0;
  99.       For y:=0 to 47 Do
  100.       Begin
  101.         Move(Font.LargeFont[f+x][y],Mem[$A000:12800+(z*80)+(x*4)+(p*1360)],3);
  102.         Inc(z);
  103.         Inc(y,2);
  104.       End;
  105.     End;
  106.     Inc(f,16);
  107.   End;
  108.  
  109.   Readln;
  110.  
  111.   Asm      { normal videomode }
  112.     Mov ah,0
  113.     Mov al,$3
  114.     Int $10
  115.   End;
  116.  
  117. End.
  118.