Liren Large Software Subsidy 16/16.iso/w/w048/2.ddi/MSSRC.ARC/MSSCRN1.PAS

Pascal/Delphi Source File | 1987-12-21 | 17.7 KB | 515 lines

{                              MSSCRN1.PAS
                                 MS 4.0
              Copyright (c) 1985, 87 by Borland International, Inc.            }

{$I msdirect.inc}

unit MsScrn1;
  {-Fast screen writing routines}

interface

uses
  Crt,                       {Basic video operations - standard unit}
  Dos,                       {DOS interface - standard unit}
  MsVars;                    {Global types and declarations}

const
  DefNoRows = 25;            {Default number of rows/physical screen}
  DefNoCols = 80;            {Default number of cols/physical screen}
  CursorOff = $2000;         {Scan lines to make cursor invisible}

type
  String255 = string[255];   {Longest Turbo string}
  String255Ptr = ^String255; {Pointer to any string}
  CharArray = array[0..DefNoCols] of Char; {Holds a line about to be written to screen}

  ColorType =                {Screen colors}
  (TxtColor,                 {Text color}
   BlockColor,               {Block color}
   BordColor,                {Window status lines}
   CmdColor,                 {Command line color}
   CursorColor,              {Color for solid block cursor, if activated}
   MnColor,                  {Normal menu color}
   MfColor,                  {Menu frame color}
   MsColor,                  {Selected menu item color}
   MhColor,                  {Highlighted selection character in menu}
   BoldColor,                {Color for bold attribute}
   DblColor,                 {Color for doublestrike attribute}
   UndColor,                 {Color for underscore attribute}
   SupColor,                 {Color for superscript attribute}
   SubColor,                 {Color for subscript attribute}
   Alt1Color,                {Color for alternate 1 attribute - Compressed}
   Alt2Color                 {Color for alternate 2 attribute - Italic}
   );

  {Stores screen attributes}
  AttributeArray = array[ColorType] of Byte;
  {Stores attributes to use for combined fonts}
  FontAttributeArray = array[0..255] of Byte;

  BoxType = (NormalBox, ErrorBox); {Defines types of popup prompt windows}
  BoxAttribute = array[BoxType] of Byte; {Defines video attributes for different types}

var
  ScreenAdr : Word;          {Base address of video memory}
  PhyScrCols : Integer;      {Columns per screen row}
  RetraceMode : Boolean;     {Check for snow on color cards?}
  CtrlAttr : Byte;           {Attribute used to display control characters}
  Tline : CharArray;         {Line of text to write to screen}
  Aline : CharArray;         {Line of attributes to write to screen}
  CursorType : Word;         {Scan lines for normal blinking cursor}
  BigCursor : Word;          {Scan lines for "fat" cursor used in insert mode}
  CenterCursor : Word;       {Scan lines for centerline cursor used in attribute mode}
  PhyscrRows : Integer;      {Number of lines/physical screen}
  LogscrRows : Integer;      {Number of lines/logical screen}
  LogtopScr : Integer;       {Physical line number for logical line #1}
  PromptRow : Integer;       {Physical line number for prompts and messages}
  InitRetracemode : Boolean; {Set if wait for retrace is needed}
  ScreenAttr : AttributeArray; {Currently selected attributes}
  EgaPresent : Boolean;      {True if EGA card selected}
  FontAttribute : FontAttributeArray; {Holds colors for font combinations}
  FullScroll : Integer;      {Number of lines to BIOS scroll at next screen update}
  TempScroll : Integer;      {Intermediate number of lines of BIOS scroll}
  UpdateScreen : Boolean;    {True when text screen must be redrawn}
  PromptLine : String255;    {Command line image}
  HelpPromptLine : String255; {Holds prompt line with menu help for top of screen}
  PromptCol : Integer;       {Column for next cmd printed on command line}
  MaxPromptChars : Integer;  {Maximum characters for prompt messages}
  MenuHelpPos : Integer;     {Screen column where menu help appears}
  CurScrCol : Byte;          {Stores screen position for solid cursor}
  CurScrRow : Byte;          {Stores screen position for solid cursor}
  FrameAttr : BoxAttribute;  {Attributes for popup window frames}
  TextAttr : BoxAttribute;   {Attributes for popup window text}

const

  {Marks start of SCREEN INSTALLATION AREA}
  ScreenIDstring : string[24] = 'SCREEN INSTALLATION AREA';

  {Colors changeable within MicroStar}
  MonoAttr : AttributeArray =
  ($07,                      {TxtColor}
   $0F,                      {BlockColor}
   $70,                      {BordColor}
   $07,                      {CmdColor}
   $70,                      {CursorColor}
   $07,                      {MnColor}
   $0F,                      {MfColor}
   $70,                      {MsColor}
   $0F,                      {MhColor}
   $0F,                      {BoldColor}
   $0F,                      {DblColor}
   $01,                      {UndColor}
   $0F,                      {SupColor}
   $0F,                      {SubColor}
   $0F,                      {Alt1Color}
   $0F                       {Alt2Color}
   );

  ColorAttr : AttributeArray =
  ($1E,                      {TxtColor}
   $17,                      {BlockColor}
   $38,                      {BordColor}
   $0F,                      {CmdColor}
   $4A,                      {CursorColor}
   $70,                      {MnColor}
   $78,                      {MfColor}
   $1F,                      {MsColor}
   $71,                      {MhColor}
   $1F,                      {BoldColor}
   $14,                      {DblColor}
   $7F,                      {UndColor}
   $15,                      {SupColor}
   $16,                      {SubColor}
   $1D,                      {Alt1Color}
   $1A                       {Alt2Color}
   );

  GoodColorCard : Boolean = False; {False to remove snow on color card}
  SolidCursor : Boolean = False; {True to avoid blinking cursor}
  Ega43lineMode : Boolean = False; {True to use 43 screen lines on EGA}

  {End of SCREEN INSTALLATION AREA}
  LastScreenDefault : Byte = 0;

procedure EdFastWrite(St : string; Row, Col, Attr : Integer);
  {-Writes St at Row,Col in Attr (video attribute) without snow}

procedure EdChangeAttribute(Number, Row, Col, Attr : Integer);
  {-Changes Number video attributes to Attr starting at Row,Col}

procedure EdMoveFromScreen(var Source, Dest; Length : Integer);
  {-Moves Length words from Source (video memory) to Dest without snow}

procedure EdMoveToScreen(var Source, Dest; Length : Integer);
  {-Moves Length words from Source to Dest (video memory) without snow}

procedure EdWrline(Row : Integer);
  {-General purpose text write - no character translation}

procedure EdWrlineCtrl(Row : Integer);
  {-General purpose text write - ctrl chars translated}

procedure EdWindow(Xmin, Ymin, Xmax, Ymax : byte);
  {-Set current window coordinates without compiler's range checking}

procedure EdSetCursor(ScanLines : Word);
  {-Change the scan lines of the hardware cursor}

procedure EdSetEga43LineMode;
  {-Switch EGA card into 43 line display}

procedure EdSetEga25lineMode;
  {-Switch EGA card back into normal 25 line display}

procedure EdSetCursorOff;
  {-turn off the hardware cursor when appropriate}

procedure EdEraseSolidCursor;
  {-For appearance sake, erase the current solid cursor before scrolling}

procedure EdDrawSolidCursor;
  {-Draw the solid cursor}

procedure EdRestoreScreenMode;
  {-Clean up screen upon exit}

procedure EdBuildFontAttribute(var Fa : FontAttributeArray);
  {-Set up the colors to use for combined fonts}

procedure EdGetScreenMode;
  {-determine screen address and colors}

  {==========================================================================}

implementation

type
  TAarray = array[0..160] of Char; {Combined line of char and attr for screen}

var
  CoverAttr : Char;          {Screen attribute overwritten by block cursor}
  EgaCursorControl : Byte absolute $40 : $87; {Deal with EGA BIOS bug}
  BiosRows : Byte absolute $40:$84; {Number of screen rows reported by BIOS}
  SaveEgaCurControl : Byte;  {Value of EgaCursorControl at startup}
  InitScreenMode : Byte;     {The video mode on entry to program}
  InitEgaRows : Byte; {Number of screen rows for initial EGA text mode}
  IsVGA : Boolean;            {true if current display is a VGA}

  {$L MSSCRN1}

  procedure EdFastWrite(St : string; Row, Col, Attr : Integer); external;
  procedure EdChangeAttribute(Number, Row, Col, Attr : Integer); external;
  procedure EdMoveFromScreen(var Source, Dest; Length : Integer); external;
  procedure EdMoveToScreen(var Source, Dest; Length : Integer); external;
  procedure EdSetCursor(ScanLines : Word); external;
  procedure EdMergeTA(var Sbuf); external;
  procedure EdMergeTActrl(var Sbuf); external;

  procedure EdWindow(Xmin, Ymin, Xmax, Ymax : byte);
    {-Set current window coordinates without compiler's range checking}
  begin     {EdWindow}
    WindMin := swap(pred(Ymin)) or pred(Xmin);
    WindMax := swap(pred(Ymax)) or pred(Xmax);
  end;      {EdWindow}

  procedure EdSetCursorOff;
    {-turn off the hardware cursor when appropriate}

  begin                      {EdSetCursorOff}
    if SolidCursor then
      {Turn off the cursor}
      EdSetCursor(CursorOff);
  end;                       {EdSetCursorOff}

  procedure EdEraseSolidCursor;
    {-For appearance sake, erase the current solid cursor before scrolling}

  begin                      {EdEraseSolidCursor}
    EdChangeAttribute(1, CurScrRow, CurScrCol, Ord(CoverAttr));
  end;                       {EdEraseSolidCursor}

  procedure EdDrawSolidCursor;
    {-Draw the solid cursor}

  begin                      {EdEraseSolidCursor}
    EdChangeAttribute(1, CurScrRow, CurScrCol, ScreenAttr[CursorColor]);
  end;                       {EdEraseSolidCursor}

  procedure EdWrline(Row : Integer);
    {-General purpose text write - no character translation}
  var
    Sbuf : TAarray;

  begin                      {EdWrline}
    {Merge text and attribute lines}
    EdMergeTA(Sbuf);
    EdMoveToScreen(Sbuf, Mem[ScreenAdr: (PhyScrCols shl 1)*Pred(Row)], PhyScrCols);
  end;                       {EdWrline}

  procedure EdWrlineCtrl(Row : Integer);
    {-General purpose text write - ctrl chars translated}
  var
    Sbuf : TAarray;
    M : Integer;

  begin                      {EdWrlineCtrl}
    {Merge text and attribute lines, filtering control characters}
    EdMergeTActrl(Sbuf);

    {Show block cursor}
    if SolidCursor then
      if (Row = CurScrRow) then begin
        M := Pred(CurScrCol);
        Sbuf[Succ(M shl 1)] := Chr(ScreenAttr[CursorColor]);
        {Save the covered attribute for later restoration}
        CoverAttr := Aline[M];
        EdDrawSolidCursor;
      end;

    EdMoveToScreen(Sbuf, Mem[ScreenAdr: (PhyScrCols shl 1)*Pred(Row)], PhyScrCols);

  end;                       {EdWrlineCtrl}

  procedure EdBuildFontAttribute(var Fa : FontAttributeArray);
    {-Set up the colors to use for combined fonts}
  var
    B, Cord : Byte;

  begin                      {EdBuildFontAttribute}
    {Nominal attribute is TxtColor}
    FillChar(Fa, SizeOf(Fa), ScreenAttr[TxtColor]);

    for B := 1 to 255 do begin
      {The lowest non-zero bit in the byte determines the color}
      Cord := 0;
      while (B and (1 shl Cord)) = 0 do
        Inc(Cord);
      if Cord <> 0 then
        Fa[B] := ScreenAttr[ColorType(Ord(BoldColor)+Cord-Ord(PrtBold))];
    end;
  end;                       {EdBuildFontAttribute}

  procedure EdSetEga43LineMode;
    {-Switch EGA card into 43 line display}
  var
    regs : registers;

  begin                      {EdSetEga43lineMode}
    {Switch to 43/50 line mode}
    with regs do begin
      ax := $1112;
      Bl := 0;
    end;
    intr($10, regs);
    PhyscrRows := succ(BiosRows);
    LogscrRows := Succ(PhyscrRows-LogtopScr);
    {Turn off EGA cursor size emulation, works around bug in EGA BIOS}
    EgaCursorControl := EgaCursorControl or 1;
    {Set funny sizes for proper EGA hardware cursor}
    CursorType := $0507;
    BigCursor := $0307;
    CenterCursor := $0107;
    EdWindow(1, 1, PhyScrCols, PhyScrRows);
  end;                       {EdSetEga43lineMode}

  procedure EdSetEga25lineMode;
    {-Switch EGA card back into normal 25 line display}
  var
    regs : registers;

  begin                      {EdSetEga25lineMode}
    with regs do begin
      if IsVGA then
        ax := $1114
      else
        ax := $1111;
      Bl := 0;
    end;
    intr($10, regs);
    PhyscrRows := Succ(BiosRows);
    LogscrRows := Succ(PhyscrRows-LogtopScr);
    {Set cursor back to normal}
    EgaCursorControl := EgaCursorControl and not(1);
    if initretracemode then begin
      CursorType := $0607;
      BigCursor := $0507;
      CenterCursor := $0307;
    end else begin
      CursorType := $0B0C;
      BigCursor := $090C;
      CenterCursor := $050C;
    end;
    EdWindow(1, 1, PhyScrCols, PhyScrRows);
  end;                       {EdSetEga25lineMode}

  procedure EdRestoreScreenMode;
    {-Clean up screen upon exit}
  var
    regs : registers;

  begin                      {EdRestoreScreenMode}
    {Restore the screen mode - also clears the screen}
    with regs do begin
      Ah := 0;
      Al := InitScreenMode;
      intr($10, regs);
    end;

    {Get into proper line count if Ega or Vga is present}
    if EgaPresent then
      if InitEgaRows > 40 then
        EdSetEga43LineMode
      else
        EdSetEga25LineMode;


    {Restore the cursor to original scan lines}
    EgaCursorControl := SaveEgaCurControl;
    EdSetCursor(CursorType);
  end;                       {EdRestoreScreenMode}

  function EdEgaPresent : Boolean;
    {-Return True if an EGA or VGA card is installed and selected}
  var
    regs : registers;

  begin                    {EdEgaPresent}
    with regs do begin
      AX := $1C00;
      CX := 7;
      intr($10, regs);
      if AL = $1C then begin
        {VGA installed - treat it like EGA}
        EdEgaPresent := True;
        IsVGA := True;
        exit;
      end else
        IsVGA := False;
      AX := $1200;
      BL := $32;
      intr($10, regs);
      if AL = $12 then begin
        {MCGA installed - we don't support its 50 line mode}
        EdEgaPresent := False;
        GoodColorCard := True;
        exit;
      end;
      Ah := $12;
      Bl := $10;
      Cx := $FFFF;
      intr($10, regs);
      {EGA present if CX was changed}
      EdEgaPresent := (Cx <> $FFFF);
    end;
  end;                     {EdEgaPresent}

  procedure EdGetScreenMode;
    {-Determine screen address and colors}
  var
    regs : registers;

  begin                      {EdGetScreenMode}

    PhyScrCols := DefNoCols; {Number of columns on the screen}
    PromptRow := 1;          {Command Line is line 1 of screen}
    LogtopScr := 2;          {Text windows don't use line 1 of screen}

    with regs do begin
      {Get screen type}
      ax := $0F00;
      intr($10, regs);
      InitScreenMode := Al;
      SaveEgaCurControl := EgaCursorControl;
      InitRetracemode := (InitScreenMode <> 7);

      {Is an EGA or VGA installed?}
      EgaPresent := EdEgaPresent;

      if EgaPresent then begin
        {See if in 43 line mode already}
        InitEgaRows := BiosRows;
        Ega43lineMode := Ega43lineMode or (InitEgaRows > 40);
      end;

      {Set screen mode to appropriate 80 column mode}
      Ah := 0;
      case InitScreenMode of
        0 : Al := 2;       {Switch from BW40 to BW80}
        1 : Al := 3;       {Switch from CO40 to CO80}
      else
        Al := InitScreenMode; {Assure color burst correct}
      end;
      intr($10, regs);

      {Store number of screen rows}
      PhyscrRows := DefNoRows;
      LogscrRows := Succ(PhyscrRows-LogtopScr);
    end;

    if EgaPresent then begin
      GoodColorCard := True;
      if Ega43lineMode then
        {Switch to 43/50 line mode}
        EdSetEga43LineMode
      else
        {Assure in 25/28 line mode}
        EdSetEga25LineMode;
    end;

    if InitRetracemode then begin
      {Color card}
      ScreenAdr := $B800;
      case InitScreenMode of
        {Color burst disabled}
        0, 2 : ScreenAttr := MonoAttr;
      else
        {Color burst on}
        ScreenAttr := ColorAttr;
      end;
      if not(EgaPresent and Ega43lineMode) then begin
        CursorType := $0607;
        BigCursor := $0507;
        CenterCursor := $0307;
      end;
    end else begin
      ScreenAdr := $B000;
      ScreenAttr := MonoAttr;
      if not(Ega43lineMode) then begin
        CursorType := $0B0C;
        BigCursor := $090C;
        CenterCursor := $050C;
      end;
    end;

    {Set up attribute table for combined fonts}
    EdBuildFontAttribute(FontAttribute);

    {Attribute used to mark control characters}
    CtrlAttr := ScreenAttr[BlockColor];

    {Attributes used to draw boxes}
    TextAttr[NormalBox] := ScreenAttr[MnColor];
    TextAttr[ErrorBox] := ScreenAttr[CursorColor];
    FrameAttr[NormalBox] := ScreenAttr[MfColor];
    FrameAttr[ErrorBox] := ScreenAttr[CursorColor];

    {Don't slow down for good color cards}
    RetraceMode := InitRetracemode and not(GoodColorCard);

    {Turn off cursor if appropriate}
    EdSetCursorOff;
  end;                       {EdGetScreenMode}

begin
  EdGetScreenMode;
  CoverAttr := Null;         {Attribute the block cursor covers}
  UpdateScreen := True;      {Screen needs updating}
  UpdateCursor := True;      {Cursor needs updating}
  FullScroll := 0;           {BIOS scrolling not currently needed}
  PromptCol := 1;            {Next cursor position on command line}
  CurScrRow := Succ(PhyscrRows); {Put block cursor off the screen}
  CurScrCol := 1;            {Initialize block cursor column}
end.