home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / VGA_FONT.ZIP / V_FONT_U.PAS next >
Encoding:
Pascal/Delphi Source File  |  1989-12-23  |  5.8 KB  |  122 lines
  1. Unit V_font_U;  { VGA font unit }
  2. { By Joe Tamburino.  This unit allows a Turbo Pascal program to use some   }
  3. { ordinary graphics primitives with text mode.  This only works with       }
  4. { EGA, VGA, and any other video card that supports the ability to redefine }
  5. { text fonts (and does so using standard INT 10h calls.)                   }
  6.  
  7. { Version 1.01.  This version has many limitations;  it is meant only as a }
  8. { demonstation of what can be done with EGA & VGA character sets.          }
  9. { Programmers are encouraged to improve this unit as they need to.  Here's }
  10. { a list of what the unit can and cannot do:                               }
  11.  
  12. {    - Ability to redefine up to 384 characters for graphics use.          }
  13. {    - Addresses a resolution of 640x400 points.  However, only 80x25 of   }
  14. {      these points have independent attributes (each character has its own}
  15. {      attribute, not each point).  200 and 350 lines modes are also       }
  16. {      supported.                                                          }
  17. {    - Most graphics primitives can use half of the available text mode    }
  18. {      attributes;  The forground intensity value cannot be independently  }
  19. {      selected.                                                           }
  20. {    - DOES NOT have the ability to prevent new characters being allocated }
  21. {      which have the same bit-pattern as existing ones.  (This is a severe}
  22. {      limitation, as most graphics primitives produce non-original chars.)}
  23. {    - However, if a character ever becomes blank, it is replaced with the }
  24. {      space character (32) and the old character is de-allocated.         }
  25. {    - Supports Hlin,Vlin,Pset,Line,Box,OpenBox, and Ellipse primitives.   }
  26.  
  27. { My address:
  28.                   Joseph J. Tamburino
  29.                   7 Chrstopher Rd.
  30.                   Westford, MA 01886
  31.                   (508) 692-7756
  32.                   CompuServe:  70033,107
  33.                   Prodigy:  NWNJ91A
  34. }
  35.  
  36. {$R-} {$S-} {$I-}
  37.  
  38. Interface
  39. Const
  40.      EGA=FALSE; VGA=TRUE;                    { Adapter contants     }
  41.      LargestChar=511;                        { Largest character #  }
  42.      SmallestChar=128;                       { Smallest character # }
  43.      FontSize=$1800;                         { 16x384 bytes         }
  44.      MaxX:  integer=(639);                   { Largest X            }
  45.      MaxY:  integer=(399);                   { Largest Y            }
  46.      EGA_VGA:  boolean=(VGA);                { Display adapter used }
  47.  
  48. Var
  49.      TotalUsed:  integer;              { # of characters used by V_FONT_U }
  50.  
  51.  
  52.      Procedure FontInit(FontBuffer,ScrnBuffer:  pointer);   { Initialization  }
  53.      Procedure Pset(x,y:  integer;  Color:  byte);          { Point plot      }
  54.      Procedure Hlin(x1,y1,x2:  integer;  Color:  byte);     { Horizontal line }
  55.      Procedure Vlin(x1,y1,y2:  integer;  Color:  byte);     { Vertical line   }
  56.      Procedure Line(x1,y1,x2,y2:  integer;  Color:  byte);  { Any line        }
  57.      Procedure Box(x1,y1,x2,y2:  integer;  Color:  byte);   { Filled box      }
  58.      Procedure OpenBox(x1,y1,x2,y2:  integer;  Color:  byte);{Unfilled box    }
  59.      Procedure Ellipse(x,y,r1,r2:  word;  Color:  byte);    { Ellipse         }
  60.      Procedure GetScrn(Buffer:  pointer);                   { Save screen     }
  61.      Procedure PutScrn(Buffer:  pointer);                   { Restore screen  }
  62.      Procedure WriteFont;                                   { Write font info }
  63.      Procedure ClearChars(ScrnBuf:  pointer);               { Clear font info }
  64.      Procedure Freeze;                                      { Halt screen     }
  65.      Procedure Unfreeze;                                    { Re-update raster}
  66.      Procedure Make512chars;                                { Use 512-char set}
  67.      Procedure MaskColors;                                  { Use only 8 color}
  68.      Procedure Make8bitChars(Lines:  integer);              { Use 200,350 line}
  69.      Procedure Make9bitChars;                               { Use 400 lines   }
  70.  
  71.  
  72. Implementation
  73. Uses Dos,Crt;
  74.  
  75. Const
  76.      Points:  byte=(16);                  { # of points (bytes)/char }
  77.      SizeFor128chars:  word=(128*16);     { Size for 128 characters  }
  78.  
  79. Var
  80.      Buffer:  pointer;                    { Character set - upper 384 chars }
  81.      CharsUsed:  array[SmallestChar..LargestChar] of boolean; {Allocated chars}
  82.      ExitSave:  pointer;                  { For exit procedure }
  83.  
  84. { Everything is external;  procedures reside in VGA_FONT.OBJ }
  85. {$L VGA_FONT }
  86. Procedure Line(x1,y1,x2,y2:  integer;  Color:  byte); External;
  87. Procedure Freeze; External;
  88. Procedure Unfreeze; External;
  89. Procedure Ellipse(x,y,r1,r2:  word;  Color:  byte); External;
  90. Procedure MaskColors; External;
  91. Procedure Make512chars; External;
  92. Procedure GetScrn(Buffer:  pointer); External;
  93. Procedure PutScrn(Buffer:  pointer); External;
  94. Procedure FontInit(FontBuffer,ScrnBuffer:  pointer); External;
  95. Procedure WriteFont; External;
  96. Procedure ClearChars(ScrnBuf:  Pointer); External;
  97. Procedure Pset(x,y:  integer;  Color:  byte); External;
  98. Procedure Hlin(x1,y1,x2:  integer;  Color:  byte); External;
  99. Procedure Vlin(x1,y1,y2:  integer;  Color:  byte); External;
  100. Procedure Box(x1,y1,x2,y2:  integer;  Color:  byte); External;
  101. Procedure OpenBox(x1,y1,x2,y2:  integer;  Color:  byte); External;
  102. Procedure Make8bitChars(Lines:  integer); External;
  103. Procedure Make9bitChars; External;
  104.  
  105. { The exit procedure:  set to default # of lines per screen: }
  106. {$F+}
  107. Procedure ExitTPC;  {$F-}
  108. Begin
  109.      if EGA_VGA=VGA then
  110.           Make9BitChars
  111.      else
  112.           Make8BitChars(350);
  113.      TextMode(co80);
  114.      ExitProc:=ExitSave
  115. End;
  116.  
  117. { The unit-initialization code simply sets up the exit procedure.  Use }
  118. { the FontInit procedure to perform other initialization.              }
  119. Begin
  120.      ExitSave:=ExitProc;
  121.      ExitProc:=@ExitTPC
  122. End.