Category : Assembly Language Source Code
Archive   : JED.ZIP
Filename : TEXTINFO.PAS

 
Output of file : TEXTINFO.PAS contained in archive : JED.ZIP
{--------------------------------------------------------------}
{ TextInfo }
{ }
{ Text video information library }
{ }
{ by Jeff Duntemann }
{ Turbo Pascal V5.0 }
{ Last update 11/20/88 }
{--------------------------------------------------------------}

UNIT TextInfo;

INTERFACE

USES DOS;


TYPE
AdapterType = (None,MDA,CGA,EGAMono,EGAColor,VGAMono,
VGAColor,MCGAMono,MCGAColor);

FontSize = (Font8,Font14,Font16);

{ The following type definition *requires* Turbo Pascal 5.0! }
OverrideProc = PROCEDURE(VAR ForceX : Byte; VAR ForceY : Byte);


VAR
TextBufferOrigin : Pointer;
TextBufferSize : Word;
VisibleX,VisibleY : Byte;


FUNCTION GetBIOSTextMode : Byte; { Returns BIOS text mode }

FUNCTION GetFontSize : FontSize; { Returns font height code }

FUNCTION GetTextBufferOrigin : Pointer; { Returns pointer to text buffer }

{ Returns visible X and Y extent plus buffer size in bytes: }

PROCEDURE GetTextBufferStats(VAR BX : Byte;
VAR BY : Byte;
VAR BuffSize : Word;
CheckForOverride : OverrideProc);

FUNCTION Monochrome : Boolean; { Returns True if monochrome display }

PROCEDURE NullOverride(VAR ForceX : Byte; VAR ForceY : Byte);

FUNCTION QueryAdapterType : AdapterType; { Returns installed display }

FUNCTION FontCode(Height : Byte) : FontSize; { Returns font height code }

FUNCTION FontHeight(Code : FontSize) : Byte; { Returns font height value}



IMPLEMENTATION


FUNCTION GetBIOSTextMode : Byte;

VAR
Regs : Registers; { Type Registers is exported by the DOS unit }

BEGIN
Regs.AH := $0F; { BIOS VIDEO Service $F: Get Current Video Mode }
Intr($10,Regs);
GetBIOSTextMode := Regs.AL; { Mode is returned in AL }
END;



FUNCTION QueryAdapterType : AdapterType;

VAR
Regs : Registers; { Type Registers is exported by the DOS unit }
Code : Byte;

BEGIN
Regs.AH := $1A; { Attempt to call VGA Identify Adapter Function }
Regs.AL := $00; { Must clear AL to 0 ... }
Intr($10,Regs);
IF Regs.AL = $1A THEN { ...so that if $1A comes back in AL... }
BEGIN { ...we know a PS/2 video BIOS is out there. }
CASE Regs.BL OF { Code comes back in BL }
$00 : QueryAdapterType := None;
$01 : QueryAdapterType := MDA;
$02 : QueryAdapterType := CGA;
$04 : QueryAdapterType := EGAColor;
$05 : QueryAdapterType := EGAMono;
$07 : QueryAdapterType := VGAMono;
$08 : QueryAdapterType := VGAColor;
$0A,$0C : QueryAdapterType := MCGAColor;
$0B : QueryAdapterType := MCGAMono;
ELSE QueryAdapterType := CGA
END { CASE }
END
ELSE
{ If it's not PS/2 we have to check for the presence of an EGA BIOS: }
BEGIN
Regs.AH := $12; { Select Alternate Function service }
Regs.BX := $10; { BL=$10 means return EGA information }
Intr($10,Regs); { Call BIOS VIDEO }
IF Regs.BX <> $10 THEN { BX unchanged means EGA is NOT there...}
BEGIN
Regs.AH := $12; { Once we know Alt Function exists... }
Regs.BL := $10; { ...we call it again to see if it's... }
Intr($10,Regs); { ...EGA color or EGA monochrome. }
IF (Regs.BH = 0) THEN QueryAdapterType := EGAColor
ELSE QueryAdapterType := EGAMono
END
ELSE { Now we know we have an CGA or MDA; let's see which: }
BEGIN
Intr($11,Regs); { Equipment determination service }
Code := (Regs.AL AND $30) SHR 4;
CASE Code of
1 : QueryAdapterType := CGA;
2 : QueryAdapterType := CGA;
3 : QueryAdapterType := MDA
ELSE QueryAdapterType := None
END { Case }
END
END;
END;



{ All we're doing here is converting numeric font heights }
{ to their corresponding values of type FontSize. }

FUNCTION FontCode(Height : Byte) : FontSize;

BEGIN
CASE Height OF
8 : FontCode := Font8;
14 : FontCode := Font14;
16 : FontCode := Font16;
END { CASE }
END;


{ Likewise, this function converts values of type FontSize }
{ to their corresponding numeriuc values. }

FUNCTION FontHeight(Code : FontSize) : Byte;

BEGIN
CASE Code OF
Font8 : FontHeight := 8;
Font14 : FontHeight := 14;
Font16 : FontHeight := 16;
END { CASE }
END;



FUNCTION GetFontSize : FontSize;

VAR
Regs : Registers; { Type Registers is exported by the DOS unit }

BEGIN
CASE QueryAdapterType OF
CGA : GetFontSize := Font8;
MDA : GetFontSize := Font14;
MCGAMono,
MCGAColor : GetFontSize := Font16; { Wretched thing knows but 1 font! }
EGAMono, { These adapters may be using any of several different }
EGAColor, { font cell heights, so we need to query the BIOS to }
VGAMono, { find out which is currently in use. }
VGAColor : BEGIN
WITH Regs DO
BEGIN
AH := $11; { EGA/VGA Information Call }
AL := $30;
BH := 0;
END;
Intr($10,Regs); { On return, CX contains the font height }
GetFontSize := FontCode(Regs.CX);
END
END { CASE }
END;



FUNCTION GetTextBufferOrigin : Pointer;

{ The rule is: For boards attached to monochrome monitors, the buffer }
{ origin is $B000:0; for boards attached to color monitors (including }
{ all composite monitors and TV's) the buffer origin is $B800:0. }

BEGIN
CASE QueryAdapterType OF
CGA,MCGAColor,EGAColor,VGAColor : GetTextBufferOrigin := Ptr($B800,0);
MDA,MCGAMono, EGAMono, VGAMono : GetTextBufferOrigin := Ptr($B000,0);
END { CASE }
END;


{ This proc provides initial values for the dimensions of the visible }
{ display and (hence) the size of the visible refresh buffer. It is }
{ called by the initialization section during startup *BUT* you must }
{ call it again after any mode change or font change to be sure of }
{ having accurate values in the three variables! }

PROCEDURE GetTextBufferStats(VAR BX : Byte; { Visible X dimension }
VAR BY : Byte; { Visible Y dimension }
VAR BuffSize : Word; { Refresh buffer size }
{ This requires TP5.0! } CheckForOverride : OverrideProc);

CONST
ScreenLinesMatrix : ARRAY[AdapterType,FontSize] OF Integer =
{ Font8: Font14: Font16: }
{ None: } ((25, 25, 25),
{ MDA: } (-1, 25, -1),
{ CGA: } (25, -1, -1),
{ EGAMono: } (43, 25, -1),
{ EGAColor: } (43, 25, -1),
{ VGAMono: } (50, 28, 25),
{ VGAColor: } (50, 28, 25),
{ MCGAMono: } (-1, -1, 25),
{ MCGAColor: } (-1, -1, 25));

VAR
Regs : Registers; { Type Registers is exported by the DOS unit }

BEGIN
Regs.AH := $0F; { BIOS VIDEO Service $F: Get Current Video Mode }
Intr($10,Regs);
BX := Regs.AH; { Number of characters in a line returned in AH }

BY := ScreenLinesMatrix[QueryAdapterType,GetFontSize];
IF BY > 0 THEN
BEGIN
CheckForOverride(BX,BY); { See if something weird is on the bus... }
BuffSize := (BX * 2) * BY { Calculate the buffer size in bytes }
END
ELSE BuffSize := 0;
END;

{ This is the default override proc, and is called anytime you're }
{ not concerned about finding a nonstandard text adapter on the }
{ bus. (Funny graphics cards with normal text modes don't matter }
{ to this library.) If you want to capture any weird cards, you }
{ must provide your own override proc that can detect the card }
{ and return correct values for the visible X and Y dimensions. }

PROCEDURE NullOverride(VAR ForceX : Byte; VAR ForceY : Byte);

BEGIN
{ Like I said; Null... }
END;


FUNCTION Monochrome : Boolean;

BEGIN
CASE QueryAdapterType OF
None,MDA,EGAMono,VGAMono,MCGAMono : Monochrome := True;
CGA,EGAColor,VGAColor,MCGAColor : Monochrome := False
END {CASE }
END;



{ The initialization section provides some initial values for the }
{ exported variables TextBufferOrigin, VisibleX, VisibleY, and }
{ TextBufferSize, so that you can use the variables without further }
{ kafeuthering. }

BEGIN
TextBufferOrigin := GetTextBufferOrigin;
GetTextBufferStats(VisibleX,VisibleY,TextBufferSize,NullOverride);
END.



  3 Responses to “Category : Assembly Language Source Code
Archive   : JED.ZIP
Filename : TEXTINFO.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/