home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / Samples / MOUSLIB8.ARJ / VIDEO.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1993-02-25  |  6.0 KB  |  190 lines
  1. (******************************************************************************
  2. *                                    video                                    *
  3. * here we have some video related procedures and functions - for text screens *
  4. ******************************************************************************)
  5. unit video;
  6. {$ifdef ovl}
  7.    {$O+,F+}
  8. {$endif}
  9.  
  10. interface
  11.  
  12. uses
  13.    dos
  14.    ;
  15.  
  16. type
  17.     fontSize = (font8,font14,font16, unknownFontSize);
  18.     adapterType = (none,mda,cga,egaMono,egaColor,vgaMono,
  19.                  vgaColor,mcgaMono,mcgaColor);
  20. var
  21.     textBufferOrigin  : pointer; {pointer to text buffer}
  22.    textBufferSeg     : word;
  23.     textBufferSize    : word;    {size in bytes of...}
  24.     visibleX,visibleY : byte;
  25.    fontLines         : byte;
  26.  
  27. function queryAdapterType : adapterType;
  28. function fontCode(h : byte) : fontSize; {convert from byte to enum}
  29. function getFontSize : fontSize; {normal 25 lines,ega 25 lines,vga 25 lines}
  30. function fontHeight(f : fontSize) : byte;
  31. procedure getTextBufferStats(var BX       : byte; {visible x dimentions}
  32.                  var BY       : byte; {visible y dimentions}
  33.                  var buffSize : word {refresh buffer size}
  34.                 );
  35. const
  36.     maxX        : integer = 79;
  37.     maxY        : integer = 24;
  38.  
  39. implementation
  40.  
  41.  
  42. (******************************************************************************
  43. *                              queryAdapterType                              *
  44. ******************************************************************************)
  45. function queryAdapterType : adapterType;
  46.  
  47. var     regs : Registers;
  48.        code : byte;
  49.  
  50. begin
  51.     regs.ah := $1a; {vga identify}
  52.     regs.al := $0;  {clear}
  53.     intr($10,regs);
  54.     if regs.al = $1a then { is this a bug ???? }
  55.     begin {ps/2 bios search for ..}
  56.         case regs.bl of {code back in here}
  57.             $00 : queryAdapterType := none;
  58.             $01 : queryAdapterType := mda;
  59.             $02 : queryAdapterType := cga;
  60.             $04 : queryAdapterType := egaColor;
  61.             $05 : queryAdapterType := egaMono;
  62.             $07 : queryAdapterType := vgaMono;
  63.             $08 : queryAdapterType := vgaColor;
  64.             $0A,$0C : queryAdapterType := mcgaColor;
  65.             $0B : queryAdapterType := mcgaMono;
  66.             else queryAdapterType := cga;
  67.         end; {case}
  68.     end {ps/2 search}
  69.     else 
  70.     begin {look for ega bios}
  71.         regs.ah := $12;
  72.         regs.bx := $10; {bl=$10 retrn ega info if ega}
  73.         intr($10,regs);
  74.         if regs.bx <> $10 then {bx unchanged mean no ega}
  75.         begin
  76.             regs.ah := $12; {ega call again}
  77.             regs.bl := $10; {recheck}
  78.             intr($10,regs);
  79.             if (regs.bh = 0) then 
  80.                 queryAdapterType := egaColor
  81.             else
  82.                 queryAdapterType := egaMono;
  83.         end {ega identification}
  84.     else {mda or cga}
  85.     begin
  86.         intr($11,regs); {get eqpt.}
  87.         code := (regs.al and $30) shr 4;
  88.         case code of
  89.             1,2 : queryAdapterType := cga;
  90.             3   : queryAdapterType := mda;
  91.             else queryAdapterType := none;
  92.         end; {case}
  93.     end {mda, cga}
  94.     end;
  95. end; {quertAdapterType}
  96.  
  97. (******************************************************************************
  98. *                             getTextBufferStats                              *
  99. * return bx = #of columns, by = #of rows, buffSize = #of bytes in buffer      *
  100. ******************************************************************************)
  101. procedure getTextBufferStats;
  102. const screenLineMatrix : array[adapterType,fontSize] of integer =
  103.     ( (25,25,25, -1) {none adapter}, (-1,25,-1, -1) {mda},
  104.       (25,-1,-1, -1) {cga},(43,25,-1, -1) {egaMono}, (43,25,-1, -1) {egaColor},
  105.       (50,28,25, -1) {vgaMono}, (50,28,25, -1) {vgaColor},
  106.       (-1,-1,25, -1) {mcgaMono}, (-1,-1,25, -1) {mcgaColor} );
  107. {this matrix is saved in font8,font14,font16 sequence in rows of matrix}
  108. var 
  109.     regs:registers;
  110. begin
  111.     regs.ah := $0f; {get current video mode}
  112.     intr($10,regs);
  113.     bx := regs.ah; {# of chars in a line, row}
  114.     by := screenLineMatrix[queryAdapterType, getFontSize];
  115.     if by > 0 then {legal height}
  116.         buffSize := bx * 2 * by
  117.     else
  118.         buffSize := 0;
  119. end; {getTextBufferStats}
  120.  
  121. (******************************************************************************
  122. *                                 getFontSize                                 *
  123. ******************************************************************************)
  124. function getFontSize : fontSize;
  125. var 
  126.     regs  : registers;
  127.    fs    : fontSize;
  128.    at    : adapterType;
  129. begin
  130.    at := queryAdapterType;
  131.     case at of
  132.         cga         : fs := font8;
  133.         mda         : fs := font14;
  134.         mcgaMono,
  135.         mcgaColor    : fs:= font16;
  136.         egaMono,
  137.         egaColor,
  138.         vgaMono,
  139.         vgaColor    : begin
  140.                     with regs do begin
  141.                (* check this interrupt call, there might be some bug, 
  142.                   either in the call conventions, or in the 3300A
  143.                   bios. *)
  144.                         ah := $11; {egavga call}
  145.                         al := $30;
  146. (*                        bl := $0;   *)
  147.                         bh := $0;   
  148.                     end; {with}
  149.                     intr($10,regs);
  150.                     fs := fontCode(regs.cl);
  151.                if (fs = unknownFontSize) then
  152.                   fs := font16; { assume a work around in 330A screen}
  153.                 end; {ega vga}
  154.     end; {case}
  155.    getFontSize := fs;
  156. end; {getFontSize}
  157.  
  158. (******************************************************************************
  159. *                                  fontCode                                   *
  160. * Convert from byte size to a fontSize type                                             *
  161. ******************************************************************************)
  162. function fontCode;
  163. begin
  164.     case h of 
  165.          8 : fontCode := font8;
  166.         14 : fontCode := font14;
  167.         16 : fontCode := font16;
  168.       else fontCode := unknownFontSize; { unKnown, assume 8 }
  169.     end; {case}
  170. end; {fontCode}
  171.  
  172. (******************************************************************************
  173. *                                 fontHeight                                 *
  174. ******************************************************************************)
  175. function fontHeight(f : fontSize) : byte;
  176. begin
  177.     case f of
  178.         font8  : fontHeight := 8;
  179.         font14 : fontHeight := 14;
  180.         font16 : fontHeight := 16;
  181.     end; {case}
  182. end; {fontHeight}
  183.  
  184. begin
  185.     getTextBufferStats(visibleX, visibleY, textBufferSize);
  186.    maxX := visibleX - 1;
  187.    maxY := visibleY - 1;
  188.    fontLines := fontHeight(getFontSize);
  189. end.
  190.