home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / JED10.ZIP / TEXTINFO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-26  |  8.9 KB  |  278 lines
  1. {--------------------------------------------------------------}
  2. {                        TextInfo                              }
  3. {                                                              }
  4. {             Text video information library                   }
  5. {                                                              }
  6. {                             by Jeff Duntemann                }
  7. {                             Turbo Pascal V5.0                }
  8. {                             Last update 11/20/88             }
  9. {--------------------------------------------------------------}
  10.  
  11. UNIT TextInfo;
  12.  
  13. INTERFACE
  14.  
  15. USES DOS;
  16.  
  17.  
  18. TYPE
  19.   AdapterType  = (None,MDA,CGA,EGAMono,EGAColor,VGAMono,
  20.                  VGAColor,MCGAMono,MCGAColor);
  21.  
  22.   FontSize     = (Font8,Font14,Font16);
  23.  
  24.   { The following type definition *requires* Turbo Pascal 5.0! }
  25.   OverrideProc = PROCEDURE(VAR ForceX : Byte; VAR ForceY : Byte);
  26.  
  27.  
  28. VAR
  29.   TextBufferOrigin  : Pointer;
  30.   TextBufferSize    : Word;
  31.   VisibleX,VisibleY : Byte;
  32.  
  33.  
  34. FUNCTION  GetBIOSTextMode : Byte;          { Returns BIOS text mode }
  35.  
  36. FUNCTION  GetFontSize : FontSize;          { Returns font height code }
  37.  
  38. FUNCTION  GetTextBufferOrigin : Pointer;   { Returns pointer to text buffer }
  39.  
  40. { Returns visible X and Y extent plus buffer size in bytes: }
  41.  
  42. PROCEDURE GetTextBufferStats(VAR BX : Byte;
  43.                              VAR BY : Byte;
  44.                              VAR BuffSize : Word;
  45.                              CheckForOverride : OverrideProc);
  46.  
  47. FUNCTION  Monochrome : Boolean;       { Returns True if monochrome display }
  48.  
  49. PROCEDURE NullOverride(VAR ForceX : Byte; VAR ForceY : Byte);
  50.  
  51. FUNCTION  QueryAdapterType : AdapterType;      { Returns installed display }
  52.  
  53. FUNCTION  FontCode(Height : Byte) : FontSize;  { Returns font height code }
  54.  
  55. FUNCTION  FontHeight(Code : FontSize) : Byte;  { Returns font height value}
  56.  
  57.  
  58.  
  59. IMPLEMENTATION
  60.  
  61.  
  62. FUNCTION GetBIOSTextMode : Byte;
  63.  
  64. VAR
  65.   Regs : Registers; { Type Registers is exported by the DOS unit }
  66.  
  67. BEGIN
  68.   Regs.AH := $0F;   { BIOS VIDEO Service $F: Get Current Video Mode }
  69.   Intr($10,Regs);
  70.   GetBIOSTextMode := Regs.AL;  { Mode is returned in AL }
  71. END;
  72.  
  73.  
  74.  
  75. FUNCTION QueryAdapterType : AdapterType;
  76.  
  77. VAR
  78.   Regs : Registers; { Type Registers is exported by the DOS unit }
  79.   Code : Byte;
  80.  
  81. BEGIN
  82.   Regs.AH := $1A;  { Attempt to call VGA Identify Adapter Function }
  83.   Regs.AL := $00;  { Must clear AL to 0 ... }
  84.   Intr($10,Regs);
  85.   IF Regs.AL = $1A THEN  { ...so that if $1A comes back in AL...  }
  86.     BEGIN                { ...we know a PS/2 video BIOS is out there. }
  87.       CASE Regs.BL OF    { Code comes back in BL }
  88.         $00 : QueryAdapterType := None;
  89.         $01 : QueryAdapterType := MDA;
  90.         $02 : QueryAdapterType := CGA;
  91.         $04 : QueryAdapterType := EGAColor;
  92.         $05 : QueryAdapterType := EGAMono;
  93.         $07 : QueryAdapterType := VGAMono;
  94.         $08 : QueryAdapterType := VGAColor;
  95.         $0A,$0C : QueryAdapterType := MCGAColor;
  96.         $0B : QueryAdapterType := MCGAMono;
  97.         ELSE QueryAdapterType := CGA
  98.       END { CASE }
  99.     END
  100.   ELSE
  101.   { If it's not PS/2 we have to check for the presence of an EGA BIOS: }
  102.     BEGIN
  103.       Regs.AH := $12;       { Select Alternate Function service }
  104.       Regs.BX := $10;       { BL=$10 means return EGA information }
  105.       Intr($10,Regs);       { Call BIOS VIDEO }
  106.       IF Regs.BX <> $10 THEN { BX unchanged means EGA is NOT there...}
  107.         BEGIN
  108.           Regs.AH := $12;   { Once we know Alt Function exists... }
  109.           Regs.BL := $10;   { ...we call it again to see if it's... }
  110.           Intr($10,Regs);   { ...EGA color or EGA monochrome. }
  111.           IF (Regs.BH = 0) THEN QueryAdapterType := EGAColor
  112.             ELSE QueryAdapterType := EGAMono
  113.         END
  114.       ELSE  { Now we know we have an CGA or MDA; let's see which: }
  115.         BEGIN
  116.           Intr($11,Regs);   { Equipment determination service }
  117.           Code := (Regs.AL AND $30) SHR 4;
  118.           CASE Code of
  119.             1 : QueryAdapterType := CGA;
  120.             2 : QueryAdapterType := CGA;
  121.             3 : QueryAdapterType := MDA
  122.             ELSE QueryAdapterType := None
  123.           END { Case }
  124.         END
  125.     END;
  126. END;
  127.  
  128.  
  129.  
  130. { All we're doing here is converting numeric font heights }
  131. { to their corresponding values of type FontSize.         }
  132.  
  133. FUNCTION FontCode(Height : Byte) : FontSize;
  134.  
  135. BEGIN
  136.   CASE Height OF
  137.      8 : FontCode := Font8;
  138.     14 : FontCode := Font14;
  139.     16 : FontCode := Font16;
  140.   END { CASE }
  141. END;
  142.  
  143.  
  144. { Likewise, this function converts values of type FontSize }
  145. { to their corresponding numeriuc values.                  }
  146.  
  147. FUNCTION FontHeight(Code : FontSize) : Byte;
  148.  
  149. BEGIN
  150.   CASE Code OF
  151.     Font8  : FontHeight := 8;
  152.     Font14 : FontHeight := 14;
  153.     Font16 : FontHeight := 16;
  154.   END { CASE }
  155. END;
  156.  
  157.  
  158.  
  159. FUNCTION GetFontSize : FontSize;
  160.  
  161. VAR
  162.   Regs : Registers;  { Type Registers is exported by the DOS unit }
  163.  
  164. BEGIN
  165.   CASE QueryAdapterType OF
  166.     CGA       : GetFontSize := Font8;
  167.     MDA       : GetFontSize := Font14;
  168.     MCGAMono,
  169.     MCGAColor : GetFontSize := Font16; { Wretched thing knows but 1 font! }
  170.     EGAMono,        { These adapters may be using any of several different }
  171.     EGAColor,       { font cell heights, so we need to query the BIOS to }
  172.     VGAMono,        { find  out which is currently in use. }
  173.     VGAColor  : BEGIN
  174.                   WITH Regs DO
  175.                     BEGIN
  176.                       AH := $11;  { EGA/VGA Information Call }
  177.                       AL := $30;
  178.                       BH := 0;
  179.                     END;
  180.                   Intr($10,Regs); { On return, CX contains the font height }
  181.                   GetFontSize := FontCode(Regs.CX);
  182.                 END
  183.   END  { CASE }
  184. END;
  185.  
  186.  
  187.  
  188. FUNCTION GetTextBufferOrigin : Pointer;
  189.  
  190. { The rule is:  For boards attached to monochrome monitors, the buffer }
  191. { origin is $B000:0; for boards attached to color monitors (including  }
  192. { all composite monitors and TV's) the buffer origin is $B800:0.       }
  193.  
  194. BEGIN
  195.   CASE QueryAdapterType OF
  196.     CGA,MCGAColor,EGAColor,VGAColor : GetTextBufferOrigin := Ptr($B800,0);
  197.     MDA,MCGAMono, EGAMono, VGAMono  : GetTextBufferOrigin := Ptr($B000,0);
  198.   END  { CASE }
  199. END;
  200.  
  201.  
  202. { This proc provides initial values for the dimensions of the visible }
  203. { display and (hence) the size of the visible refresh buffer.  It is  }
  204. { called  by the initialization section during startup *BUT* you must }
  205. { call it again after any mode change or font change to be sure of    }
  206. { having accurate values in the three variables! }
  207.  
  208. PROCEDURE GetTextBufferStats(VAR BX : Byte;        { Visible X dimension }
  209.                              VAR BY : Byte;        { Visible Y dimension }
  210.                              VAR BuffSize : Word;  { Refresh buffer size }
  211. { This requires TP5.0! }     CheckForOverride : OverrideProc);
  212.  
  213. CONST
  214.   ScreenLinesMatrix : ARRAY[AdapterType,FontSize] OF Integer =
  215.                    { Font8:  Font14: Font16: }
  216.   {      None: }     ((25,     25,     25),
  217.   {       MDA: }      (-1,     25,     -1),
  218.   {       CGA: }      (25,     -1,     -1),
  219.   {   EGAMono: }      (43,     25,     -1),
  220.   {  EGAColor: }      (43,     25,     -1),
  221.   {   VGAMono: }      (50,     28,     25),
  222.   {  VGAColor: }      (50,     28,     25),
  223.   {  MCGAMono: }      (-1,     -1,     25),
  224.   { MCGAColor: }      (-1,     -1,     25));
  225.  
  226. VAR
  227.   Regs : Registers;   { Type Registers is exported by the DOS unit }
  228.  
  229. BEGIN
  230.   Regs.AH := $0F; { BIOS VIDEO Service $F: Get Current Video Mode }
  231.   Intr($10,Regs);
  232.   BX := Regs.AH;  { Number of characters in a line returned in AH }
  233.  
  234.   BY := ScreenLinesMatrix[QueryAdapterType,GetFontSize];
  235.   IF BY > 0 THEN
  236.     BEGIN
  237.       CheckForOverride(BX,BY);  { See if something weird is on the bus... }
  238.       BuffSize := (BX * 2) * BY { Calculate the buffer size in bytes }
  239.     END
  240.   ELSE BuffSize := 0;
  241. END;
  242.  
  243. { This is the default override proc, and is called anytime you're }
  244. { not concerned about finding a nonstandard text adapter on the   }
  245. { bus.  (Funny graphics cards with normal text modes don't matter }
  246. { to this library.)  If you want to capture any weird cards, you  }
  247. { must provide your own override proc that can detect the card    }
  248. { and return correct values for the visible X and Y dimensions.   }
  249.  
  250. PROCEDURE NullOverride(VAR ForceX : Byte; VAR ForceY : Byte);
  251.  
  252. BEGIN
  253.   { Like I said; Null... }
  254. END;
  255.  
  256.  
  257. FUNCTION Monochrome : Boolean;
  258.  
  259. BEGIN
  260.   CASE QueryAdapterType OF
  261.     None,MDA,EGAMono,VGAMono,MCGAMono : Monochrome := True;
  262.     CGA,EGAColor,VGAColor,MCGAColor   : Monochrome := False
  263.   END {CASE }
  264. END;
  265.  
  266.  
  267.  
  268. { The initialization section provides some initial values for the   }
  269. { exported variables TextBufferOrigin, VisibleX, VisibleY, and      }
  270. { TextBufferSize, so that you can use the variables without further }
  271. { kafeuthering. }
  272.  
  273. BEGIN
  274.   TextBufferOrigin := GetTextBufferOrigin;
  275.   GetTextBufferStats(VisibleX,VisibleY,TextBufferSize,NullOverride);
  276. END.
  277.  
  278.