Simtel MSDOS - Coast to Coast/simteldosarchivecoasttocoast2.iso/turbopas/pstui100.zip/PTUIVCRT.PAS

Pascal/Delphi Source File | 1993-03-12 | 27KB | 1,091 lines

{

                                                      ╔══════════════════╗
                                                      ║  PTUI Virual     ║
                                                      ║  Screen Driver   ║
                                                      ║    Rev. 1.00     ║
                                                      ╚══════════════════╝

}

{$F-} {$O-} {$A+} {$G-}
{$V-} {$B-} {$X-} {$N+} {$E+}

{$I FINAL.PAS}

{$IFDEF FINAL}
  {$I-} {$R-}
  {$D-} {$L-} {$S-}
{$ENDIF}

Unit PTUIVCRT;

Interface

Uses CRT,Strings;

Const
  LMem_CRTPortBase = $463;
  LMem_BufferLength= $44c;
  LMem_NumberOfRows= $484;
  LMem_NumberOfCols= $44a;
  LMem_CurrentMode = $449;
  LMem_BIOSFlags   = $489;

  MonoCard         =    1;
  ColorCard        =    2;
  Blink            =  128;
  Black            =    0;
  Blue             =    1;
  Green            =    2;
  Cyan             =    3;
  Red              =    4;
  Magenta          =    5;
  Brown            =    6;
  LightGray        =    7;
  LightGrey        =    7;
  DarkGray         =    8;
  DarkGrey         =    8;
  LightBlue        =    9;
  LightGreen       =   10;
  LightCyan        =   11;
  LightRed         =   12;
  LightMagenta     =   13;
  Yellow           =   14;
  White            =   15;

Type
  MonoOrColor      = MonoCard..ColorCard;

  VideoScrollTypes = (ScrollAutoDetect, ScrollMethod1, ScrollMethod2,
                      ScrollMethod3);

  VideoCardTypes   = (MDA,CGA,EGA,VGA,SVGA,BWVGA,HerculesInColor);

  VideoStateType   = Record
                       FunctionalityInfo :Pointer;
                       VideoMode         :Byte;
                       Columns           :Word;
                       RegenBufferLength :Word;
                       RegenBufferAddr   :Word;
                       CursorPos         :Array[1..8,1..2] of Byte;
                       CursorType        :Word;
                       ActivePage        :Byte;
                       CRTControllerAddr :Word;
                       Register3x8       :Byte;
                       Register3x9       :Byte;
                       Rows              :Byte;
                       CharacterHeight   :Word;
                       DisplayCode       :Byte;
                       DisplayCodeAlt    :Byte;
                       ColoursSupport    :Word;
                       TotalDisplayPages :Byte;
                       TotalScanLines    :Byte;
                       PrimaryCharBlock  :Byte;
                       SecondaryCharBlock:Byte;
                       StateInformation  :Byte;
                       Reserved1         :Array[1..3] of Byte;
                       VideoMemory       :Byte;
                       SavePointerState  :Byte;
                       Reserved2         :Array[1..14] Of Byte;
                     End;

  OneVideoCard     = Record
                       XSize           :Word;
                       YSize           :Word;
                       SX1,SY1,                   {Screen}
                       SX2,SY2         :Word;
                       WX1,WY1,
                       WX2,WY2         :Word;     {Window View Port}
                       Address         :Word;     {Screen Segment to Display}
                       CardType        :VideoCardTypes;
                       CharacterHeight :Byte;
                       CharacterLength :Byte;
                       ScrollMethod    :VideoScrollTypes;
                     End;

Var
  VideoCard             :Array [MonoCard..ColorCard] of OneVideoCard;
  Card                  :MonoOrColor;
  TextAttr              :Byte;               {Background, Forground}
  LastMode              :Byte;
  Cursor                :Boolean;
  VX                    :Word;
  VY                    :Word;

Function  VideoWriteAddress(X1,Y1:Word):Pointer;
Procedure InitVideoCards;
Procedure SetVirtualScreen (XSize,YSize:Word);
Procedure ScreenOrigin     (X,Y:Word);

Procedure PositionCursor;
Procedure GotoXY           (X,Y:Word);
Function  WhereX           :Word;
Function  WhereY           :Word;
Procedure ClrScr;
Procedure ClrEOL;
Procedure DelLine;
Procedure InsLine;
Procedure TextMode         (AL:Byte;BX,CX,DX:Word);
Procedure TextColor        (Forg:Byte);
Procedure TextBackground   (Backg:Byte);
Procedure VideoColor       (Forg,Backg:Byte);
Procedure HighVideo;
Procedure LowVideo;
Function  BackgroundColor  :Byte;
Function  ForgroundColor   :Byte;
Procedure Window           (X1,Y1,X2,Y2:Word);
Procedure WriteChr         (Charac:Char);
Procedure WriteStr         (Line:String);
Procedure WriteStrLn       (Line:String);
Procedure ReadStr          (X,Y:Word;MaxLets:Byte;Upper:Boolean;
                            Var MainStr:String);
Procedure EditStr          (X,Y:Word;MaxLets:Byte;Upper:Boolean;
                            Var MainStr:String);
Procedure Pad              (Count:Word;WithChar:Char);
Procedure Barometer        (X,Y:Word;MaxLen:Byte;WithMe:Char;
                            Current,EndPoint:LongInt);
Procedure FillBlock        (X1,Y1,X2,Y2:Word;WithChar:Char);
Function  TextImageSize    (X1,Y1,X2,Y2:Word):LongInt;
Procedure GetTextImage     (X1,Y1,X2,Y2:Word;Data:Pointer);
Procedure PutTextImage     (X1,Y1:Word;Data:Pointer);
Procedure WindowToVScreen  (Var X1,Y1:Integer);
Procedure WindowToVScreen4 (Var X1,Y1,X2,Y2:Integer);
Procedure ScreenToVScreen  (Var X1,Y1:Integer);
Procedure ScreenToVScreen4 (Var X1,Y1,X2,Y2:Integer);

Implementation

Function VideoWriteAddress(X1,Y1:Word):Pointer;
Begin
  Inc(X1,VideoCard[Card].WX1 - 1);
  Inc(Y1,VideoCard[Card].WY1 - 1);
  VideoWriteAddress:=Ptr(VideoCard[Card].Address,
                         (((Y1-1)*VideoCard[Card].XSize*2)+((X1-1)*2)));
End;

Procedure InitVideoCards;
Begin
  VideoCard[MonoCard].XSize    :=80;
  VideoCard[MonoCard].YSize    :=25;
  VideoCard[MonoCard].SX1      :=1;
  VideoCard[MonoCard].SY1      :=1;
  VideoCard[MonoCard].SX2      :=80;
  VideoCard[MonoCard].SY2      :=25;
  VideoCard[MonoCard].WX1      :=1;
  VideoCard[MonoCard].WY1      :=1;
  VideoCard[MonoCard].WX2      :=80;
  VideoCard[MonoCard].WY2      :=25;
  VideoCard[MonoCard].Address  :=$B000;
  VideoCard[MonoCard].CardType :=MDA;
  VideoCard[MonoCard].CharacterHeight:=16;
  VideoCard[MonoCard].CharacterLength:=8;
  VideoCard[MonoCard].ScrollMethod   :=ScrollAutoDetect;

  VideoCard[ColorCard].XSize    :=80;
  VideoCard[ColorCard].YSize    :=25;
  VideoCard[ColorCard].SX1      :=1;
  VideoCard[ColorCard].SY1      :=1;
  VideoCard[ColorCard].SX2      :=80;
  VideoCard[ColorCard].SY2      :=25;
  VideoCard[ColorCard].WX1      :=1;
  VideoCard[ColorCard].WY1      :=1;
  VideoCard[ColorCard].WX2      :=80;
  VideoCard[ColorCard].WY2      :=25;
  VideoCard[ColorCard].Address  :=$B800;
  VideoCard[ColorCard].CardType :=CGA;
  VideoCard[ColorCard].CharacterHeight:=16;
  VideoCard[ColorCard].CharacterLength:=9;
  VideoCard[ColorCard].ScrollMethod   :=ScrollAutoDetect;

  If MemW[$0:$0463] = $3B4 then
    Card := MonoCard
  Else
    Card := ColorCard;
End;

Procedure SetVirtualScreen(XSize,YSize:Word);
Begin
  VideoCard[ColorCard].XSize    :=XSize;
  VideoCard[ColorCard].YSize    :=YSize;
  VideoCard[ColorCard].SX1      :=1;
  VideoCard[ColorCard].SY1      :=1;
  VideoCard[ColorCard].WX1      :=1;
  VideoCard[ColorCard].WY1      :=1;
  VideoCard[ColorCard].WX2      :=XSize;
  VideoCard[ColorCard].WY2      :=YSize;

  Asm
    xor   ax, ax
    mov   es, ax
    mov   ax, XSize
    mov   es:[LMem_NumberOfCols], ax
    mov   cx, ax
    mov   bx, YSize
    dec   bx
    mov   es:[LMem_NumberOfRows], bl
    inc   bx
    mul   bl
    shl   ax, 1
    mov   es:[LMem_BufferLength], ax

    shr   cx, 1
    mov   ah, cl
    mov   al, 13h
    mov   dx, es:[LMem_CRTPortBase]
    out   dx, ax
  End;
End;

Procedure ScreenOrigin(X,Y:Word);

Var
  SX,
  SY,
  BytesPerRow     :Word;
  CharacterHeight :Byte;
  CharacterLength :Byte;
  ScrollMethod    :VideoScrollTypes;

Label
  UseAutoDetect,
  Method1,
  Method2,
  Method3,
  Continue;

Begin
  BytesPerRow        :=VideoCard[Card].XSize * 2;
  CharacterHeight    :=VideoCard[Card].CharacterHeight;
  CharacterLength    :=VideoCard[Card].CharacterLength;
  ScrollMethod       :=VideoCard[Card].ScrollMethod;

  SX                 :=VideoCard[Card].SX2 - VideoCard[Card].SX1;
  SY                 :=VideoCard[Card].SY2 - VideoCard[Card].SY1;
  VideoCard[Card].SX1:=(X Div CharacterLength) + 1;
  VideoCard[Card].SY1:=(Y Div CharacterHeight) + 1;
  VideoCard[Card].SX2:=VideoCard[Card].SX1 + SX;
  VideoCard[Card].SY2:=VideoCard[Card].SY1 + SY;


  Asm
    xor    ax, ax
    mov    es, ax

    mov    ax, X
    mov    bx, Y

    xor    ch, ch
    mov    cl, CharacterLength
    div    cl

    mov    dl, ScrollMethod
    cmp    dl, ScrollAutoDetect
    je     UseAutoDetect
    cmp    dl, ScrollMethod1
    je     Method1
    cmp    dl, ScrollMethod2
    je     Method2
    cmp    dl, ScrollMethod3
    je     Method3

                                {AL = X / CharacterLength}
                                {AH = Remainder}
                                {BX = Y}

UseAutoDetect:

    mov    cl, es:[LMem_CurrentMode]
    cmp    cl, 7

    je     Method2
    ja     Method1
    test   byte ptr es:[LMem_BIOSFlags], 1
    jnz    Method2
    jz     Method3

Method1:

    mov    cl, ah
    xor    ah, ah
    xchg   ax, bx             {BL = X / CharacterLength}
    mul    BytesPerRow        {AX = Y * BytesPerRow}
    jmp    Continue           {CL = Remainder of X / CharacterLength}

Method2:

    dec    ah
    jns    Method3
    mov    ah, 8

Method3:

    mov    cl, ah             {CL = Remainder of X / CharacterLength}
    xor    ah, ah
    xchg   ax, bx
    div    CharacterHeight    {BL = Y / CharacterLength}
                              {AL = Y / CharacterHeight, AH = Remainder}
    xchg   ah, ch             {AH = 0, CH = Remainder}
    mul    BytesPerRow        {AX = (Y / CharacterHeight) * BytesPerRow / 2}
    shr    ax, 1

Continue:

    add    bx, ax
    mov    dx, es:[LMem_CRTPortBase]
    add    dl, 6

@@1:
    in     al, dx
    test   al, 8
    jz     @@1

@@2:
    in     al, dx
    test   al, 8
    jnz    @@2

    cli
    sub    dl, 6

    mov    ah, bh
    mov    al, 0ch
    out    dx, ax

    mov    ah, bl
    inc    al
    out    dx, ax

    sti

    add    dl, 6

@@3:
    in     al, dx
    test   al, 8
    jz     @@3

    cli

    sub    dl, 6
    mov    ah, ch
    mov    al, 8
    out    dx, ax

    mov    dl, 0c0h
    mov    al, 13h or 20h
    out    dx, al

    mov    al, cl
    out    dx, al

    sti
  End;
End;

Procedure PositionCursor;

Var
  X,Y   :Word;

Begin
  X:=VX + (VideoCard[Card].WX1 - 1) - 1;
  Y:=VY + (VideoCard[Card].WY1 - 1) - 1;
  Asm
    mov   ah, 2
    mov   bx, X
    mov   cx, Y
    mov   dl, bl
    mov   dh, cl
    xor   bh, bh
    int   10h
  End;
End;

Procedure GotoXY(X,Y:Word);
Begin
  VX:=X;
  VY:=Y;
  If Cursor Then PositionCursor;
End;

Function WhereX:Word;
Begin
  WhereX:=VX;
End;

Function WhereY:Word;
Begin
  WhereY:=VY;
End;

Procedure ClrScr;

Var
  Total,
  Temp   :Word;

Begin
  Temp :=VideoCard[Card].Address;
  Total:=VideoCard[Card].YSize*VideoCard[Card].XSize;
  Asm
    cld
    mov    ax, Temp
    mov    es, ax
    xor    di, di
    mov    ah, TextAttr
    mov    cx, Total
    mov    al, 32
    rep    stosw
  End;
  VX:=1;
  VY:=1;
  If Cursor Then PositionCursor;
End;

Procedure ClrEOL;

Var
  Q          :Pointer;
  TotalChars :Integer;

Begin
  TotalChars:=VideoCard[Card].XSize - VX + VideoCard[Card].WX1;
  Q:=VideoWriteAddress(VX,VY);
  Asm
    cld
    les   di, Q
    mov   cx, TotalChars
    mov   ah, TextAttr
    mov   al, 32
    rep   stosw
  End;
End;

Procedure DelLine;

Var
  LineSize:Word;
  Total   :Word;
  Q       :Pointer;

Begin
  LineSize:=VideoCard[Card].XSize;
  Total   :=(VideoCard[Card].YSize - VY)*VideoCard[Card].XSize;
  Q       :=VideoWriteAddress(1,VY);

  Asm
    cld
    mov    bx, LineSize
    shl    bx, 1
    mov    cx, Total
    les    di,Q
    mov    si, di
    add    si, bx

    push   ds
    mov    ax, es
    mov    ds, ax
    rep    movsw
    pop    ds
  End;
  FillBlock(1,VideoCard[Card].YSize,VideoCard[Card].XSize,VideoCard[Card].YSize,' ');
End;

Procedure InsLine;

Var
  LineSize:Word;
  Total   :Word;
  Q       :Pointer;

Begin
  LineSize:=VideoCard[Card].XSize;
  Total   :=(VideoCard[Card].YSize - VY)*VideoCard[Card].XSize;
  Q       :=VideoWriteAddress(VideoCard[Card].XSize,VideoCard[Card].YSize);

  Asm
    std
    mov    bx, LineSize
    shl    bx, 1
    mov    cx, Total
    les    di,Q
    mov    si, di
    sub    si, bx

    push   ds
    mov    ax, es
    mov    ds, ax
    rep    movsw
    pop    ds
  End;
  FillBlock(1,VY,VideoCard[Card].XSize,VY,' ');
End;

Procedure TextMode(AL:Byte;BX,CX,DX:Word);

Var
  NewModeInfo   :VideoStateType;
  P             :Pointer;

Begin
  Asm
    xor   ah, ah
    mov   al, &AL
    mov   bx, &BX
    mov   cx, &CX
    mov   dx, &DX
    int   10h                   {Set Video Mode}
  End;

  FillChar(NewModeInfo,SizeOf(NewModeInfo),0);
  P:=Addr(NewModeInfo);
  If VideoCard[Card].CardType=SVGA Then
  Begin
    Asm
      les   di, P
      mov   ax, 1B00h
      xor   bx, bx
      int   10h                   {Get Video Mode Information}
    End;

    VideoCard[Card].XSize    :=NewModeInfo.Columns;
    VideoCard[Card].YSize    :=NewModeInfo.Rows;
    VideoCard[Card].SX1      :=1;
    VideoCard[Card].SY1      :=1;
    VideoCard[Card].SX2      :=NewModeInfo.Columns;
    VideoCard[Card].SY2      :=NewModeInfo.Rows;
    VideoCard[Card].WX1      :=1;
    VideoCard[Card].WY1      :=1;
    VideoCard[Card].WX2      :=NewModeInfo.Columns;
    VideoCard[Card].WY2      :=NewModeInfo.Rows;
    VideoCard[Card].Address  :=$B800;
    VideoCard[Card].CharacterHeight:=NewModeInfo.CharacterHeight;
    If NewModeInfo.Columns>=80 Then
      VideoCard[Card].CharacterLength:=8
    Else
      VideoCard[Card].CharacterLength:=9;
    VideoCard[Card].ScrollMethod   :=ScrollAutoDetect;
  End;

  VX:=1;
  VY:=1;
End;

Procedure TextColor(Forg:Byte);
Begin
  Forg:=Forg And $8F;
  TextAttr:=TextAttr And $F0;
  TextAttr:=TextAttr Or Forg;
End;

Procedure TextBackground(Backg:Byte);
Begin
  Backg:=Backg shl 4;
  TextAttr:=TextAttr And $0F;
  TextAttr:=TextAttr Or Backg;
End;

Procedure VideoColor(Forg,Backg:Byte);
Begin
  TextAttr:=Forg And $8F;
  Backg:=Backg shl 4;
  TextAttr:=TextAttr Or Backg;
End;

Procedure HighVideo;
Begin
  If (TextAttr And $0F)<8 Then Inc(TextAttr,8);
End;

Procedure LowVideo;
Begin
  If (TextAttr And $0F)>7 Then Dec(TextAttr,8);
End;

Function ForgroundColor:Byte;
Begin
  ForgroundColor:=TextAttr And $8F;
End;

Function BackgroundColor:Byte;
Begin
  BackgroundColor:=TextAttr And $70;
End;

Procedure Window(X1,Y1,X2,Y2:Word);
Begin
  VideoCard[Card].WX1:=X1;
  VideoCard[Card].WY1:=Y1;
  VideoCard[Card].WX2:=X2;
  VideoCard[Card].WY2:=Y2;
  VX:=1;
  VY:=1;
  If Cursor Then PositionCursor;
End;

Procedure WriteChr(Charac:Char);

Var
  Q     :Pointer;

Begin
  Q:=VideoWriteAddress(VX,VY);
  Asm
    cld
    les   di, Q
    mov   ah, TextAttr
    mov   al, Charac
    stosw
    inc   VX
  End;

  If VX>VideoCard[Card].XSize Then
  Begin
    Inc(VY,VX Div VideoCard[Card].XSize);
    VX:=VX Mod VideoCard[Card].XSize;
  End;
  If Cursor Then PositionCursor;
End;

Procedure WriteStr(Line:String);

Var
  X     :Word;
  Q     :Pointer;

Label
  EndLoop,
  CopyLoop;

Begin
  Q:=VideoWriteAddress(VX,VY);
  Asm
    cld
    push  ds
    les   di, Q
    mov   ah, TextAttr

    lea   si, Line
    mov   cx, ss
    mov   ds, cx
    lodsb
    mov   cl, al
    xor   ch, ch
    mov   dx, cx
    jcxz  EndLoop

CopyLoop:

    lodsb
    stosw

    loop  CopyLoop

EndLoop:

    pop   ds

    add   VX, dx
  End;

  If VX>VideoCard[Card].XSize Then
  Begin
    Inc(VY,VX Div VideoCard[Card].XSize);
    VX:=VX Mod VideoCard[Card].XSize;
  End;
  If Cursor Then PositionCursor;
End;

Procedure WriteStrLn(Line:String);
Begin
  WriteStr(Line);
  Inc(VY);
  If VY>VideoCard[Card].YSize Then
  Begin
    VX:=1;
    VY:=1;
    DelLine;
    VY:=VideoCard[Card].YSize;
  End;
  VX:=1;
  If Cursor Then PositionCursor;
End;

Procedure ReadStr(X,Y:Word;MaxLets:Byte;Upper:Boolean;Var MainStr:String);
Begin
  MainStr:='';
  EditStr(X,Y,MaxLets,Upper,MainStr);
End;

Procedure EditStr(X,Y:Word;MaxLets:Byte;Upper:Boolean;Var MainStr:String);

{Procedure Edits a string allowing for cursor keys and backspace keys.}
{It reads the string at X,Y and will only allow MaxLets number of letters}
{to be entered.  It puts the letters into MainStr.  Optionally UpperCase Only.}

Var
  Ins             :Boolean;   {Boolean for the Insert Key Status}
  C               :Char;      {Current Character}
  Count,                      {Number Of Chars In String}
  CurXPos         :Byte;      {Current X Position of Cursor}
  CursorSizeSave  :Word;
  OldCur          :XYPosData; {Old Cursor Position}
  OldCurVal       :Boolean;

Begin
  OldCurVal:=Cursor;
  Cursor:=True;
  SaveCursorSize(CursorSizeSave);
  CursorSize(1,VideoCard[Card].CharacterHeight);    {Set the cursor size to a block}
  Ins:=False;                {The Insert key has not yet been pressed}
  CurXPos:=1;                {Current Relative X Position+1}
  SaveXYPos(OldCur);         {Save the Cursor Position}
  GotoXY(X,Y);
  UnPadVar(MainStr,MainStr);
  If Length(MainStr)>MaxLets Then
    MainStr:=Copy(MainStr,1,MaxLets);
  WriteStr(MainStr);
  Pad(MaxLets-Length(MainStr),' ');
  Count:=Length(MainStr)+1;  {How many letters in the string+1}

  Repeat                     {Repeat Until [Return] is Pressed}
    GotoXY(X+CurXPos-1,Y);   {Goto the Requested Area}
    If Upper Then
      C:=UpCase(ReadKey)
    Else
      C:=ReadKey;

    If C=Chr(0) Then         {Check for a cursor key}
    Begin
      C:=ReadKey;            {Which cursor key}         {Numeric Keypad Value}
      If (C='O') Then CurXPos:=Count;                            {1}
      If (C='P') And (CurXPos>=3) Then Dec(CurXPos,2);           {2}
      If (C='Q') And (CurXPos>=4) Then Dec(CurXPos,3);           {3}
      If (C='K') And (CurXPos>1) Then Dec(CurXPos);              {4}
      If (C='M') And (CurXPos<Count) Then Inc(CurXPos);          {6}
      If (C='G') Then CurXPos:=1;                                {7}
      If (C='H') And (CurXPos<=Count-2) Then Inc(CurXPos,2);     {8}
      If (C='I') And (CurXPos<=Count-3) Then Inc(CurXPos,3);     {9}
      If (C=#7 ) Then MainStr[0]:=Chr(CurXPos-1);                {Shift-Del}
      If (C='S') And (Count>1) Then                              {Del}
      Begin
        Delete(MainStr,CurXPos,1);
        GotoXY(X,Y);
        WriteStr(MainStr+' ');
        Dec(Count);
        GotoXY(X-1+CurXPos,Y);
      End;
      If (C='R') Then                                            {Ins}
      Begin
        Ins:=Not Ins;
        If Ins Then
           CursorSize(VideoCard[Card].CharacterHeight-1,VideoCard[Card].CharacterHeight)
        Else
           CursorSize(1,VideoCard[Card].CharacterHeight);
      End;
      GotoXY(X-1+CurXPos,Y);
    End  {End Extended Key}
    Else
    Begin

      If (C=#17) Then                           {^Q}
      Begin
        C:=ReadKey;
        If C=#0 Then
          C:=ReadKey
        Else
        If C in ['y','Y',#25] Then
        Begin
          MainStr[0]:=Chr(CurXPos-1);
          Count:=CurXPos;
          GotoXY(X,Y);
          WriteStr(MainStr);
          Pad(MaxLets-Length(MainStr),' ');
        End;
      End
      Else
      If (C=#27) Then
      Begin
        GotoXY(X,Y);
        Pad(MaxLets,' ');
        MainStr:='';
        C:=#13;
      End
      Else
      If (C=#8) Then                     {Was BackSpace Presssed?}
      Begin
        If (CurXPos>1) Then              {Can I BackSpace?}
        Begin
          Delete(MainStr,CurXPos-1,1);   {Delete the char}
          GotoXY(X,Y);
          WriteStr(MainStr+' ');            {Redisplay the String}
          Dec(Count);                    {One less char}
          Dec(CurXPos);                  {Move Back}
          GotoXY(X-1+CurXPos,Y);         {Goto Position}
        End;                             {End 'Can I BackSpace?'}
      End                                {End 'Was BackSpace Pressed?'}
      Else                               {No Not BackSpace - A Normal Letter}
        If (CurXPos<=MaxLets) And (C<>#13) Then    {Is there Space?}
        Begin
          If Ins Or (CurXPos>=Count) Then   {Must I Insert the Char?}
          Begin
            If Count<=MaxLets Then
              Begin
                Insert(C,MainStr,CurXPos);  {Insert the Char}
                Inc(Count);                 {Add 1 to Count}
                Inc(CurXPos);               {Move Cursor}
              End;                          {End Check for Space in String}
          End                               {End Check to see if Ins was True}
          Else                              {No, Do not Insert, Overwrite}
          Begin
            MainStr[CurXPos]:=C;      {Overwrite char}
            Inc(CurXPos);             {Move Cursor}
          End;                        {End Insert / Overwrite}

          If CurXPos<Count Then       {If the char was Inserted, Rewrite}
          Begin                       {the entire String to the screen}
            GotoXY(X,Y);
            WriteStr(MainStr);
            GotoXY(X-1+CurXPos,Y);
          End                         {End Rewrite the String to the screen}
          Else                        {Need Not Rewrite the entire String}
             WriteChr(C);             {Just Display the new char}
        End;
    End;                              {End Area which accepts a BackSpace or a Letter}
  Until C=#13;

  RestXYPos(OldCur);
  RestCursorSize(CursorSizeSave);
  UnPadVar(MainStr,MainStr);
  Cursor:=OldCurVal;
End;

Procedure Pad(Count:Word;WithChar:Char);

Var
  Q     :Pointer;

Begin
  Q:=VideoWriteAddress(VX,VY);
  Asm
    cld
    les    di, Q
    mov    cx, Count
    add    VX, cx
    mov    ah, TextAttr
    mov    al, WithChar
    rep    stosw
  End;
  If VX>VideoCard[Card].XSize Then
  Begin
    Inc(VY,VX Div VideoCard[Card].XSize);
    VX:=VX Mod VideoCard[Card].XSize;
  End;
  If Cursor Then PositionCursor;
End;

Procedure Barometer(X,Y:Word;MaxLen:Byte;WithMe:Char;
                    Current,EndPoint:LongInt);

Const
  Previous:Byte = 0;

Var
  HowFar:Byte;

Begin
  GotoXY(X,Y);
  HowFar:=(Current*MaxLen) Div EndPoint;
  If HowFar<>Previous Then Pad(HowFar,WithMe);
  Previous:=HowFar;
End;

Procedure FillBlock(X1,Y1,X2,Y2:Word;WithChar:Char);

Var
  Q        :Pointer;
  LineSize :Word;

Label
  CopyLoop;

Begin
  Q       :=VideoWriteAddress(X1,Y1);
  LineSize:=VideoCard[Card].XSize;

  Asm
    cld
    mov    cx, Y2
    sub    cx, Y1
    inc    cx

    mov    bx, X2
    sub    bx, X1
    inc    bx

    mov    si, LineSize
    sub    si, bx
    shl    si, 1

    les    di, Q
    mov    ah, TextAttr
    mov    al, WithChar

CopyLoop:
    mov    dx, cx
    mov    cx, bx
    rep    stosw
    add    di, si
    mov    cx, dx
    loop   CopyLoop

  End;
End;

Function TextImageSize(X1,Y1,X2,Y2:Word):LongInt;
Begin
  TextImageSize:=((
                   (LongInt(Y2)-LongInt(Y1)+1) *
                   (LongInt(X2)-LongInt(X1)+1)
                  ) * 2
                 )+4;
End;

Procedure GetTextImage(X1,Y1,X2,Y2:Word;Data:Pointer);

Var
  Q          :Pointer;
  XSize      :Word;

Label
  CopyLoop;

Begin
  Q     :=VideoWriteAddress(X1,Y1);
  XSize :=VideoCard[Card].XSize;

  Asm
    cld
    mov    ax, X2
    sub    ax, X1
    inc    ax

    les    di, Data

    stosw
    mov    dx, ax

    mov    ax, Y2
    sub    ax, Y1
    inc    ax
    mov    cx, ax

    stosw

    mov    bx, XSize
    sub    bx, dx
    shl    bx, 1

    push   ds

    lds    si, Q

CopyLoop:
    mov    ax, cx
    mov    cx, dx
    rep    movsw
    add    si, bx
    mov    cx, ax
    loop   CopyLoop

    pop    ds
  End;
End;

Procedure PutTextImage(X1,Y1:Word;Data:Pointer);

Var
  Q          :Pointer;
  XSize      :Word;

Label
  CopyLoop;

Begin
  Q     :=VideoWriteAddress(X1,Y1);
  XSize :=VideoCard[Card].XSize;

  Asm
    cld
    push   ds
    lds    si, Data
    lodsw
    mov    dx, ax
    lodsw
    mov    cx, ax
    les    di, Q

    mov    bx, XSize
    sub    bx, dx
    shl    bx, 1

CopyLoop:
    mov    ax, cx
    mov    cx, dx
    rep    movsw
    add    di, bx
    mov    cx, ax
    loop   CopyLoop

    pop    ds
  End;
End;

Procedure WindowToVScreen(Var X1,Y1:Integer);
{Converts Window Area Address to VScreen Address}
Begin
  X1:=X1 - 1 + VideoCard[Card].WX1;
  Y1:=Y1 - 1 + VideoCard[Card].WY1;
End;

Procedure WindowToVScreen4(Var X1,Y1,X2,Y2:Integer);
{Converts Window Area Address to VScreen Address}
Begin
  X1:=X1 - 1 + VideoCard[Card].WX1;
  Y1:=Y1 - 1 + VideoCard[Card].WY1;
  X2:=X2 - 1 + VideoCard[Card].WX2;
  Y2:=Y2 - 1 + VideoCard[Card].WY2;
End;

Procedure ScreenToVScreen(Var X1,Y1:Integer);
{Converts Screen Area Address to VScreen Address - Ideal For Mouse}
Begin
  X1:=X1 - 1 + VideoCard[Card].SX1;
  Y1:=Y1 - 1 + VideoCard[Card].SY1;
End;

Procedure ScreenToVScreen4(Var X1,Y1,X2,Y2:Integer);
{Converts Screen Area Address to VScreen Address - Ideal For Mouse}
Begin
  X1:=X1 - 1 + VideoCard[Card].SX1;
  Y1:=Y1 - 1 + VideoCard[Card].SY1;
  X2:=X2 - 1 + VideoCard[Card].SX2;
  Y2:=Y2 - 1 + VideoCard[Card].SY2;
End;

Begin
  TextAttr:=$0007;
  Asm
    mov   ah, 0fh
    int   10h
    mov   LastMode, al
  End;
  VX:=1;
  VY:=1;
  Cursor:=True;
  InitVideoCards;
End.

{ Copyright 1993, Michael Gallias }