home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / ddjmag / ddj8903.arc / DUNTEMAN.LST < prev    next >
File List  |  1989-02-10  |  20KB  |  613 lines
  1. _STRUCTURED PROGRAMMING COLUMN_
  2. by Jeff Duntemann
  3.  
  4. [LISTING ONE]
  5.  
  6.  
  7. {--------------------------------------------------------------}
  8. {                        TextInfo                              }
  9. {                                                              }
  10. {             Text video information library                   }
  11. {                                                              }
  12. {                             by Jeff Duntemann                }
  13. {                             Turbo Pascal V5.0                }
  14. {                             Last update 11/20/88             }
  15. {--------------------------------------------------------------}
  16.  
  17. UNIT TextInfo;
  18.  
  19. INTERFACE
  20.  
  21. USES DOS;
  22.  
  23.  
  24. TYPE
  25.   AdapterType  = (None,MDA,CGA,EGAMono,EGAColor,VGAMono,
  26.                  VGAColor,MCGAMono,MCGAColor);
  27.  
  28.   FontSize     = (Font8,Font14,Font16);
  29.  
  30.   { The following type definition *requires* Turbo Pascal 5.0! }
  31.   OverrideProc = PROCEDURE(VAR ForceX : Byte; VAR ForceY : Byte);
  32.  
  33.  
  34. VAR
  35.   TextBufferOrigin  : Pointer;
  36.   TextBufferSize    : Word;
  37.   VisibleX,VisibleY : Byte;
  38.  
  39.  
  40. FUNCTION  GetBIOSTextMode : Byte;          { Returns BIOS text mode }
  41.  
  42. FUNCTION  GetFontSize : FontSize;          { Returns font height code }
  43.  
  44. FUNCTION  GetTextBufferOrigin : Pointer;   { Returns pointer to text buffer }
  45.  
  46. { Returns visible X and Y extent plus buffer size in bytes: }
  47.  
  48. PROCEDURE GetTextBufferStats(VAR BX : Byte;
  49.                              VAR BY : Byte;
  50.                              VAR BuffSize : Word;
  51.                              CheckForOverride : OverrideProc);
  52.  
  53. PROCEDURE NullOverride(VAR ForceX : Byte; VAR ForceY : Byte);
  54.  
  55. FUNCTION  QueryAdapterType : AdapterType;      { Returns installed display }
  56.  
  57. FUNCTION  FontCode(Height : Byte) : FontSize;  { Returns font height code }
  58.  
  59. FUNCTION  FontHeight(Code : FontSize) : Byte;  { Returns font height value}
  60.  
  61.  
  62.  
  63. IMPLEMENTATION
  64.  
  65.  
  66. FUNCTION GetBIOSTextMode : Byte;
  67.  
  68. VAR
  69.   Regs : Registers; { Type Registers is exported by the DOS unit }
  70.  
  71. BEGIN
  72.   Regs.AH := $0F;   { BIOS VIDEO Service $F: Get Current Video Mode }
  73.   Intr($10,Regs);
  74.   GetBIOSTextMode := Regs.AL;  { Mode is returned in AL }
  75. END;
  76.  
  77.  
  78.  
  79. FUNCTION QueryAdapterType : AdapterType;
  80.  
  81. VAR
  82.   Regs : Registers; { Type Registers is exported by the DOS unit }
  83.   Code : Byte;
  84.  
  85. BEGIN
  86.   Regs.AH := $1A;  { Attempt to call VGA Identify Adapter Function }
  87.   Regs.AL := $00;  { Must clear AL to 0 ... }
  88.   Intr($10,Regs);
  89.   IF Regs.AL = $1A THEN  { ...so that if $1A comes back in AL...  }
  90.     BEGIN                { ...we know a PS/2 video BIOS is out there. }
  91.       CASE Regs.BL OF    { Code comes back in BL }
  92.         $00 : QueryAdapterType := None;
  93.         $01 : QueryAdapterType := MDA;
  94.         $02 : QueryAdapterType := CGA;
  95.         $04 : QueryAdapterType := EGAColor;
  96.         $05 : QueryAdapterType := EGAMono;
  97.         $07 : QueryAdapterType := VGAMono;
  98.         $08 : QueryAdapterType := VGAColor;
  99.         $0A,$0C : QueryAdapterType := MCGAColor;
  100.         $0B : QueryAdapterType := MCGAMono;
  101.         ELSE QueryAdapterType := CGA
  102.       END { CASE }
  103.     END
  104.   ELSE
  105.   { If it's not PS/2 we have to check for the presence of an EGA BIOS: }
  106.     BEGIN
  107.       Regs.AH := $12;       { Select Alternate Function service }
  108.       Regs.BX := $10;       { BL=$10 means return EGA information }
  109.       Intr($10,Regs);       { Call BIOS VIDEO }
  110.       IF Regs.BX <> $10 THEN { BX unchanged means EGA is NOT there...}
  111.         BEGIN
  112.           Regs.AH := $12;   { Once we know Alt Function exists... }
  113.           Regs.BL := $10;   { ...we call it again to see if it's... }
  114.           Intr($10,Regs);   { ...EGA color or EGA monochrome. }
  115.           IF (Regs.BH = 0) THEN QueryAdapterType := EGAColor
  116.             ELSE QueryAdapterType := EGAMono
  117.         END
  118.       ELSE  { Now we know we have an CGA or MDA; let's see which: }
  119.         BEGIN
  120.           Intr($11,Regs);   { Equipment determination service }
  121.           Code := (Regs.AL AND $30) SHR 4;
  122.           CASE Code of
  123.             1 : QueryAdapterType := CGA;
  124.             2 : QueryAdapterType := CGA;
  125.             3 : QueryAdapterType := MDA
  126.             ELSE QueryAdapterType := None
  127.           END { Case }
  128.         END
  129.     END;
  130. END;
  131.  
  132.  
  133. { All we're doing here is converting numeric font heights }
  134. { to their corresponding values of type FontSize.         }
  135.  
  136. FUNCTION FontCode(Height : Byte) : FontSize;
  137.  
  138. BEGIN
  139.   CASE Height OF
  140.      8 : FontCode := Font8;
  141.     14 : FontCode := Font14;
  142.     16 : FontCode := Font16;
  143.   END { CASE }
  144. END;
  145.  
  146.  
  147. { Likewise, this function converts values of type FontSize }
  148. { to their corresponding numeriuc values.                  }
  149.  
  150. FUNCTION FontHeight(Code : FontSize) : Byte;
  151.  
  152. BEGIN
  153.   CASE Code OF
  154.     Font8  : FontHeight := 8;
  155.     Font14 : FontHeight := 14;
  156.     Font16 : FontHeight := 16;
  157.   END { CASE }
  158. END;
  159.  
  160.  
  161.  
  162. FUNCTION GetFontSize : FontSize;
  163.  
  164. VAR
  165.   Regs : Registers;  { Type Registers is exported by the DOS unit }
  166.  
  167. BEGIN
  168.   CASE QueryAdapterType OF
  169.     CGA       : GetFontSize := Font8;
  170.     MDA       : GetFontSize := Font14;
  171.     MCGAMono,
  172.     MCGAColor : GetFontSize := Font16; { Wretched thing knows but 1 font! }
  173.     EGAMono,        { These adapters may be using any of several different }
  174.     EGAColor,       { font cell heights, so we need to query the BIOS to }
  175.     VGAMono,        { find  out which is currently in use. }
  176.     VGAColor  : BEGIN
  177.                   WITH Regs DO
  178.                     BEGIN
  179.                       AH := $11;  { EGA/VGA Information Call }
  180.                       AL := $30;
  181.                       BH := 0;
  182.                     END;
  183.                   Intr($10,Regs); { On return, CX contains the font height }
  184.                   GetFontSize := FontCode(Regs.CX);
  185.                 END
  186.   END  { CASE }
  187. END;
  188.  
  189.  
  190.  
  191. FUNCTION GetTextBufferOrigin : Pointer;
  192.  
  193. { The rule is:  For boards attached to monochrome monitors, the buffer }
  194. { origin is $B000:0; for boards attached to color monitors (including  }
  195. { all composite monitors and TV's) the buffer origin is $B800:0.       }
  196.  
  197. BEGIN
  198.   CASE QueryAdapterType OF
  199.     CGA,MCGAColor,EGAColor,VGAColor : GetTextBufferOrigin := Ptr($B800,0);
  200.     MDA,MCGAMono, EGAMono, VGAMono  : GetTextBufferOrigin := Ptr($B000,0);
  201.   END  { CASE }
  202. END;
  203.  
  204.  
  205. { This proc provides initial values for the dimensions of the visible }
  206. { display and (hence) the size of the visible refresh buffer.  It is  }
  207. { called  by the initialization section during startup *BUT* you must }
  208. { call it again after any mode change or font change to be sure of    }
  209. { having accurate values in the three variables! }
  210.  
  211. PROCEDURE GetTextBufferStats(VAR BX : Byte;        { Visible X dimension }
  212.                              VAR BY : Byte;        { Visible Y dimension }
  213.                              VAR BuffSize : Word;  { Refresh buffer size }
  214. { This requires TP5.0! }     CheckForOverride : OverrideProc);
  215.  
  216. CONST
  217.   ScreenLinesMatrix : ARRAY[AdapterType,FontSize] OF Integer =
  218.                    { Font8:  Font14: Font16: }
  219.   {      None: }     ((25,     25,     25),
  220.   {       MDA: }      (-1,     25,     -1),
  221.   {       CGA: }      (25,     -1,     -1),
  222.   {   EGAMono: }      (43,     25,     -1),
  223.   {  EGAColor: }      (43,     25,     -1),
  224.   {   VGAMono: }      (50,     28,     25),
  225.   {  VGAColor: }      (50,     28,     25),
  226.   {  MCGAMono: }      (-1,     -1,     25),
  227.   { MCGAColor: }      (-1,     -1,     25));
  228.  
  229. VAR
  230.   Regs : Registers;   { Type Registers is exported by the DOS unit }
  231.  
  232. BEGIN
  233.   Regs.AH := $0F; { BIOS VIDEO Service $F: Get Current Video Mode }
  234.   Intr($10,Regs);
  235.   BX := Regs.AH;  { Number of characters in a line returned in AH }
  236.  
  237.   BY := ScreenLinesMatrix[QueryAdapterType,GetFontSize];
  238.   IF BY > 0 THEN
  239.     BEGIN
  240.       CheckForOverride(BX,BY);  { See if something weird is on the bus... }
  241.       BuffSize := (BX * 2) * BY { Calculate the buffer size in bytes }
  242.     END
  243.   ELSE BuffSize := 0;
  244. END;
  245.  
  246. { This is the default override proc, and is called anytime you're }
  247. { not concerned about finding a nonstandard text adapter on the   }
  248. { bus.  (Funny graphics cards with normal text modes don't matter }
  249. { to this library.)  If you want to capture any weird cards, you  }
  250. { must provide your own override proc that can detect the card    }
  251. { and return correct values for the visible X and Y dimensions.   }
  252.  
  253. PROCEDURE NullOverride(VAR ForceX : Byte; VAR ForceY : Byte);
  254.  
  255. BEGIN
  256.   { Like I said; Null... }
  257. END;
  258.  
  259.  
  260. { The initialization section provides some initial values for the   }
  261. { exported variables TextBufferOrigin, VisibleX, VisibleY, and      }
  262. { TextBufferSize, so that you can use the variables without further }
  263. { kafeuthering. }
  264.  
  265. BEGIN
  266.   TextBufferOrigin := GetTextBufferOrigin;
  267.   GetTextBufferStats(VisibleX,VisibleY,TextBufferSize,NullOverride);
  268. END.
  269.  
  270.  
  271. [LISTING TWO]
  272.  
  273.  
  274. PROGRAM TextTest;
  275.  
  276. USES TextInfo;
  277.  
  278. BEGIN
  279.   Write('The installed adapter is ');
  280.   CASE QueryAdapterType OF
  281.     None : Writeln('nothing I''ve ever seen.');
  282.     MDA  : Writeln('an MDA .');
  283.     CGA  : Writeln('a CGA.');
  284.     EGAMono,EGAColor : Writeln('an EGA.');
  285.     VGAMono,VGAColor : Writeln('a VGA.');
  286.     MCGAMono,MCGAColor : Writeln('an MCGA.');
  287.   END; { CASE }
  288.   Writeln('The current font height is ',FontHeight(GetFontSize),'.');
  289.   Writeln('The current BIOS text mode is ',GetBIOSTextMode,'.');
  290.   Writeln('The current screen is ',VisibleX,' character wide',
  291.           ' and ',VisibleY,' characters wide;');
  292.  
  293.   Writeln('  and occupies ',TextBufferSize,' bytes in memory.');
  294. END.
  295.  
  296.  
  297. [LISTING THREE]
  298.  
  299.  
  300. (*--------------------------------------------------------------*)
  301. (*                        TEXTINFO                              *)
  302. (*                                                              *)
  303. (*     Text video information library -- Definition module      *)
  304. (*                                                              *)
  305. (*                             by Jeff Duntemann                *)
  306. (*                             TopSpeed Modula 2 V1.12          *)
  307. (*                             Last update 12/7/88              *)
  308. (*--------------------------------------------------------------*)
  309.  
  310. DEFINITION MODULE TextInfo;
  311.  
  312. TYPE
  313.   AdapterType = (None,MDA,CGA,EGAMono,EGAColor,VGAMono,
  314.                  VGAColor,MCGAMono,MCGAColor);
  315.  
  316.   FontSize    = (Font8,Font14,Font16);
  317.  
  318.   OverrideProc = PROCEDURE(VAR BYTE,VAR BYTE);
  319.  
  320. VAR
  321.   TextBufferOrigin  : ADDRESS;   (* Address of video refresh buffer   *)
  322.   TextBufferSize    : CARDINAL;  (* Bytes contained in refresh buffer *)
  323.   VisibleX,VisibleY : SHORTCARD; (* Dimensions of the visible display *)
  324.  
  325.  
  326. PROCEDURE GetBIOSTextMode() : SHORTCARD;
  327.  
  328. PROCEDURE GetTextBufferOrigin() : ADDRESS;
  329.  
  330. PROCEDURE GetTextBufferStats(VAR BufX : BYTE;         (* Visible X dimension *)
  331.                              VAR BufY : BYTE;         (* Visible Y dimension *)
  332.                              VAR BuffSize : CARDINAL; (* Refresh buffer size *)
  333.                              CheckForOverride : OverrideProc);
  334.  
  335. PROCEDURE QueryAdapterType() : AdapterType;
  336.  
  337. PROCEDURE FontCode(Height : SHORTCARD) : FontSize;
  338.  
  339. PROCEDURE FontHeight(Code : FontSize) : SHORTCARD;
  340.  
  341. PROCEDURE GetFontSize() : FontSize;
  342.  
  343. PROCEDURE NullOverride(VAR ForceX : BYTE; VAR ForceY : BYTE);
  344.  
  345. END TextInfo.
  346.  
  347.  
  348. [LISTING FOUR]
  349.  
  350.  
  351. (*--------------------------------------------------------------*)
  352. (*                        TEXTINFO                              *)
  353. (*                                                              *)
  354. (*   Text video information library -- Implementation module    *)
  355. (*                                                              *)
  356. (*                             by Jeff Duntemann                *)
  357. (*                             TopSpeed Modula 2 V1.12          *)
  358. (*                             Last update 12/7/88              *)
  359. (*--------------------------------------------------------------*)
  360.  
  361. IMPLEMENTATION MODULE TextInfo;
  362.  
  363. FROM SYSTEM IMPORT Registers;
  364. FROM Lib IMPORT Intr;
  365.  
  366. VAR
  367.   ColorBufOrg [0B800H:0] : WORD; (* First word in color refresh buffer *)
  368.   MonoBufOrg  [0B000H:0] : WORD; (* First word in mono refresh buffer *)
  369.  
  370.  
  371. PROCEDURE GetBIOSTextMode() : SHORTCARD;
  372.  
  373. VAR
  374.   Regs : Registers;
  375.  
  376. BEGIN
  377.   Regs.AH := 0FH;    (* VIDEO service 0FH *)
  378.   Intr(Regs,10H);
  379.   RETURN Regs.AL     (* AL contains current text mode on return *)
  380. END GetBIOSTextMode;
  381.  
  382.  
  383. PROCEDURE QueryAdapterType() : AdapterType;
  384.  
  385. VAR
  386.   Regs : Registers;
  387.   Code : SHORTCARD;
  388.  
  389.  
  390. BEGIN
  391.   Regs.AH := 1AH;  (* Attempt to call VGA Identify Adapter Function *)
  392.   Regs.AL := 0;          (* Must clear AL to 0 ... *)
  393.   Intr(Regs,10H);
  394.   IF Regs.AL = 1AH THEN  (* ...so that if $1A comes back in AL...  *)
  395.                          (* ...we know a PS/2 video BIOS is out there. *)
  396.     CASE Regs.BL OF      (* Code comes back in BL *)
  397.       0 : RETURN None             |
  398.       1 : RETURN MDA;             |
  399.       2 : RETURN CGA;             |
  400.       4 : RETURN EGAColor;        |
  401.       5 : RETURN EGAMono;         |
  402.       7 : RETURN VGAMono;         |
  403.       8 : RETURN VGAColor;        |
  404.       0AH,0CH : RETURN MCGAColor; |
  405.       0BH : RETURN MCGAMono;      |
  406.       ELSE RETURN CGA
  407.     END (* CASE *)
  408.   ELSE
  409.   (* If it's not PS/2 we have to check for the presence of an EGA BIOS: *)
  410.     Regs.AH := 12H;       (* Select Alternate Function service *)
  411.     Regs.BX := 10H;       (* BL=$10 means return EGA information *)
  412.     Intr(Regs,10H);       (* Call BIOS VIDEO *)
  413.     IF Regs.BX <> 10H THEN (* BX unchanged means EGA is NOT there...*)
  414.         Regs.AH := 12H;   (* Once we know Alt Function exists... *)
  415.         Regs.BL := 10H;   (* ...we call it again to see if it's... *)
  416.         Intr(Regs,10H);   (* ...EGA color or EGA monochrome. *)
  417.         IF (Regs.BH = 0) THEN RETURN EGAColor
  418.         ELSE RETURN EGAMono
  419.         END
  420.     ELSE  (* Now we know we have an CGA or MDA; let's see which: *)
  421.       Intr(Regs,11H);   (* Equipment determination service *)
  422.       Code := SHORTCARD(BITSET(Regs.AL) * BITSET{4..5}) >> 4;
  423.       CASE Code OF
  424.         1 : RETURN CGA  |
  425.         2 : RETURN CGA  |
  426.         3 : RETURN MDA
  427.         ELSE RETURN None
  428.       END (* Case *)
  429.     END
  430.   END
  431. END QueryAdapterType;
  432.  
  433.  
  434. (* This is a simple "clean conversion" function for relating the *)
  435. (* enumerated font size constants to SHORTCARD numeric font size *)
  436. (* values.  *)
  437.  
  438. PROCEDURE FontCode(Height : SHORTCARD) : FontSize;
  439.  
  440. BEGIN
  441.   CASE Height OF
  442.     8 : RETURN Font8  |
  443.    14 : RETURN Font14 |
  444.    16 : RETURN Font16
  445.    ELSE RETURN Font8
  446.   END  (* CASE *)
  447. END FontCode;
  448.  
  449.  
  450. (* This is a simple "clean conversion" function for relating the  *)
  451. (* SHORTCARD numeric font size values to the enumerated font size *)
  452. (* constants *)
  453.  
  454. PROCEDURE FontHeight(Code : FontSize) : SHORTCARD;
  455.  
  456. BEGIN
  457.   CASE Code OF
  458.     Font8  : RETURN 8  |
  459.     Font14 : RETURN 14 |
  460.     Font16 : RETURN 16
  461.   END (* CASE *)
  462. END FontHeight;
  463.  
  464.  
  465.  
  466. PROCEDURE GetFontSize() : FontSize;
  467.  
  468. VAR
  469.   Regs : Registers;
  470.  
  471. BEGIN
  472.   CASE QueryAdapterType() OF
  473.     CGA       : RETURN Font8  |
  474.     MDA       : RETURN Font14 |
  475.     MCGAMono,
  476.     MCGAColor : RETURN Font16 |
  477.     EGAMono,        (* These adapters may be using any of several  *)
  478.     EGAColor,       (* different font cell heights, so we need to query *)
  479.     VGAMono,        (* BIOS to find out which is currently in use. *)
  480.     VGAColor  : WITH Regs DO
  481.                   AH := 11H;  (* EGA/VGA Information Call *)
  482.                   AL := 30H;
  483.                   BL := 0;
  484.                 END;
  485.                 Intr(Regs,10H);
  486.                 RETURN FontCode(SHORTCARD(Regs.CX))
  487.   END  (* CASE *)
  488. END GetFontSize;
  489.  
  490.  
  491. PROCEDURE GetTextBufferOrigin() : ADDRESS;
  492.  
  493. (* The rule is:  For boards attached to monochrome monitors, the buffer *)
  494. (* origin is $B000:0; for boards attached to color monitors (including  *)
  495. (* all composite monitors and TV's) the buffer origin is $B800:0.       *)
  496.  
  497. BEGIN
  498.   CASE QueryAdapterType() OF
  499.     CGA,MCGAColor,EGAColor,VGAColor : RETURN ADR(ColorBufOrg) |
  500.     MDA,MCGAMono, EGAMono, VGAMono  : RETURN ADR(MonoBufOrg)
  501.   END  (* CASE *)
  502. END GetTextBufferOrigin;
  503.  
  504.  
  505. (* This one function returns essential screen/buffer size information. *)
  506. (* It is called by the initializing body of this module but should be  *)
  507. (* called again after *any* mode change or font change! *)
  508.  
  509. PROCEDURE GetTextBufferStats(VAR BufX : BYTE;         (* Visible X dimension *)
  510.                              VAR BufY : BYTE;         (* Visible Y dimension *)
  511.                              VAR BuffSize : CARDINAL; (* Refresh buffer size *)
  512.                              CheckForOverride : OverrideProc);
  513.  
  514. TYPE
  515.   FontPoints  = ARRAY[Font8..Font16] OF INTEGER;
  516.   PointsArray = ARRAY[None..MCGAColor] OF FontPoints;
  517.  
  518. VAR
  519.   Regs : Registers;   (* Type Registers is exported by the DOS unit *)
  520.   ScreenLinesMatrix : PointsArray;
  521.   Adapter : AdapterType;
  522.   Font    : FontSize;
  523.  
  524. (* TopSpeed can't do two-dimensional array aggregates, Turbo Pascal *)
  525. (* style (arrgh) so we have to make it an array of arrays: *)
  526.  
  527. BEGIN
  528.   ScreenLinesMatrix := PointsArray(
  529.   (*      None: *)     FontPoints(25,     25,     25),
  530.   (*       MDA: *)     FontPoints(-1,     25,     -1),
  531.   (*       CGA: *)     FontPoints(25,     -1,     -1),
  532.   (*   EGAMono: *)     FontPoints(43,     25,     -1),
  533.   (*  EGAColor: *)     FontPoints(43,     25,     -1),
  534.   (*   VGAMono: *)     FontPoints(50,     28,     25),
  535.   (*  VGAColor: *)     FontPoints(50,     28,     25),
  536.   (*  MCGAMono: *)     FontPoints(-1,     -1,     25),
  537.   (* MCGAColor: *)     FontPoints(-1,     -1,     25));
  538.  
  539.   Regs.AH := 0FH;  (* BIOS VIDEO Service $F: Get Current Video Mode *)
  540.   Intr(Regs,10H);
  541.   BufX := Regs.AH; (* Number of characters in a line returned in AH *)
  542.  
  543.   BufY := SHORTCARD(ScreenLinesMatrix[QueryAdapterType(),GetFontSize()]);
  544.   IF SHORTCARD(BufY) > 0 THEN
  545.     CheckForOverride(BufX,BufY);  (* See if odd adapter is on the bus... *)
  546.     (* Calculate the buffer size in bytes: *)
  547.     BuffSize := (CARDINAL(BufX) * 2) * CARDINAL(BufY)
  548.     ELSE BuffSize := 0
  549.   END
  550. END GetTextBufferStats;
  551.  
  552.  
  553. (* This is the "default" override proc, called when there is no *)
  554. (* suspicion of anything nonstandard on the bus.  Replace with  *)
  555. (* a custom proc that looks for any nonstandard video adapter.  *)
  556.  
  557. PROCEDURE NullOverride(VAR ForceX : BYTE; VAR ForceY : BYTE);
  558.  
  559. BEGIN
  560.   (* Like I said; Null... *)
  561. END NullOverride;
  562.  
  563.  
  564. (* The module body, like a Pascal unit initialization section, is *)
  565. (* executed before the client program that imports this module or *)
  566. (* any part of it. *)
  567.  
  568. BEGIN
  569.   TextBufferOrigin := GetTextBufferOrigin();
  570.   GetTextBufferStats(VisibleX,VisibleY,TextBufferSize,NullOverride);
  571. END TextInfo.
  572.  
  573.  
  574. [LISTING FIVE]
  575.  
  576.  
  577. MODULE TextTest;
  578.  
  579. FROM IO       IMPORT WrStr,WrLn,WrCard,WrShtCard;
  580. FROM TextInfo IMPORT AdapterType,QueryAdapterType,GetFontSize,
  581.                      FontHeight,GetBIOSTextMode,VisibleX,VisibleY,
  582.                      TextBufferSize;
  583.  
  584. BEGIN
  585.   WrStr("The installed adapter is ");
  586.   CASE QueryAdapterType() OF
  587.     None : WrStr("nothing I've ever seen.")     |
  588.     MDA  : WrStr("an MDA.")                     |
  589.     CGA  : WrStr("a CGA.")                      |
  590.     EGAMono,EGAColor : WrStr("an EGA.")         |
  591.     VGAMono,VGAColor : WrStr("a VGA.")          |
  592.     MCGAMono,MCGAColor : WrStr("an MCGA.");
  593.   END; (* CASE *)
  594.   WrLn;
  595.   WrStr('The current font height is ');
  596.   WrShtCard(FontHeight(GetFontSize()),2);
  597.   WrStr("."); WrLn;
  598.   WrStr("The current BIOS text mode is ");
  599.   WrShtCard(GetBIOSTextMode(),2);
  600.   WrStr("."); WrLn;
  601.   (* VisibleX and VisibleY are initialized by TextInfo module body *)
  602.   WrStr("The current screen is ");
  603.   WrShtCard(VisibleX,2);
  604.   WrStr(" character wide and ");
  605.   WrShtCard(VisibleY,2);
  606.   WrStr(" characters high;");
  607.   WrLn;
  608.   WrStr("  and occupies ");
  609.   (* TextBufferSize is initialized by TextInfo module body *)
  610.   WrCard(TextBufferSize,6);
  611.   WrStr(" bytes in memory."); WrLn;
  612. END TextTest.
  613.