Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MADTRB13.ZIP/PFIELD.PAS

Pascal/Delphi Source File | 1985-05-26 | 5.9 KB | 162 lines

{ A set of routines for protected field forms input
  By Bela Lubkin
  Borland International Technical Support
  1/23/85
  (For PC-DOS Turbo Pascal version 2 or greater)
}

Type
  ScreenType=Array [0..1999] Of Record
                                  Ch: Char;
                                  At: Byte;
                                End;

Var
  Screen: ^ScreenType;   { Points to the screen in use, either mono or color }
  ConInPtr1,ConOutPtr1: Integer;  { The addresses of the old console drivers }
  XCursor,YCursor: Byte;              { Current cursor address on the screen }
  ProtectiOn: Boolean;                            { In protected field mode? }

Procedure GotoXYTurbo(X,Y: Byte);                      { Call Turbo's GotoXY }
  Begin
    GotoXY(X,Y);
  End;

Procedure GotoXY(X,Y: Byte);            { Position the cursor and keep track }
  Begin                                                     { of where it is }
    GotoXYTurbo(X,Y);
    XCursor:=X;
    YCursor:=Y;
  End;

Procedure FindForward;    { If protected mode is on, make sure the cursor is }
  Var                  { on a hilighted character by moving it forward until }
    I,J: Integer;        { a non-lowlighted character is found.  If none are }
                        { found anywhere on the screen, the cursor is placed }
  Begin                  { at 1,1, the upper left hand corner of the screen. }
    If ProtectiOn Then      { Note that lowlighted characters are considered }
     Begin                     { to be those with attribute 7: lowlight only }
      I:=80*YCursor+XCursor-81;
      If Screen^[I].At=7 Then    { <--- the choice of attribute for lowlight }
       Begin
        J:=(I+1) Mod 2000;
        While (J<>I) And (Screen^[J].At=7) Do      { <--- lowlight attribute }
         Begin
          J:=J+1;
          If J=2000 Then J:=0;
         End;
        If J=I Then J:=0;      { If we wrapped all the way around the screen }
        GotoXY(J Mod 80+1,J Div 80+1); { without finding a place, choose 1,1 }
       End;                        { Position the cursor at the chosen place }
     End;
  End;

Procedure PutCh(C: Byte);  { ConOutPtr points to this.  Print a character on }
  Var                        { the screen.  Skip lowlighted areas if protect }
    I,J: Integer;                                              { mode is on. }

  Begin
    If C=8 Then                  { Handle backspace.  Must skip backwards to }
     Begin                                     { previous highlighted field. }
      If ProtectiOn Then
       Begin
        I:=80*YCursor+XCursor-81;
        J:=(I+1999) Mod 2000;
        If Screen^[J].At=7 Then
         Begin
          While (J<>I) And (Screen^[(J+1999) Mod 2000].At=7) Do
            J:=(J+1999) Mod 2000;
          If J=I Then J:=1;
          GotoXY(J Mod 80+1,J Div 80+1);
         End;
       End;
      If XCursor>1 Then XCursor:=XCursor-1;
     End
    Else If C=10 Then      { Handle linefeed.  Mishandled slightly -- should }
     Begin                { do a FindForward but not until after calling the }
      If YCursor<25 Then YCursor:=YCursor+1;                 { old ConOutPtr }
     End
    Else If C=13 Then XCursor:=1       { Handle CR.  Mishandled the same way }
    Else               { Handle normal character.  If protection is on, find }
     Begin              { an unprotected field before writing the character. }
      FindForward;
      If XCursor<80 Then XCursor:=XCursor+1
      Else
       Begin
        XCursor:=1;
        If YCursor<25 Then YCursor:=YCursor+1;
       End;
     End;
    InLine($89/$EC  /  $5D  /  $FF/$26/ConOutPtr1);        { Jump to the old }
    {      MOV SP,BP   POP BP  JMP [ConOutPtr1] }    { console output driver }
  End;

Function GetCh: Char;     { ConInPtr points to this.  Its only purpose is to }
  Begin                    { make the blinking cursor appear where the typed }
    FindForward;                          { character will appear, on input. }
    InLine($89/$EC  /  $5D  /  $FF/$26/ConInPtr1);         { Jump to the old }
    {      MOV SP,BP   POP BP  JMP [ConInPtr1] }      { console input driver }
  End;

Procedure InitProtect;     { Does the following: figures out which screen is }
  Var                       { being used; turns protection off; sets XCursor }
    M,C: Integer;              { and YCursor to 1; saves pointers to the old }
    T: Byte;                    { console drivers; points the console driver }
                                               { pointers to PutCh and GetCh }
  Begin
    M:=MemW[$B000:0];
    C:=MemW[$B800:0];
    T:=64;
    If (Hi(M)=T) Or (Hi(C)=T) Then T:=65;
    If (Hi(M)=T) Or (Hi(C)=T) Then T:=66;
    GotoXY(1,1);
    Write(Chr(T));
    If Mem[$B000:0]=T Then Screen:=Ptr($B000,0)
    Else Screen:=Ptr($B800,0);
    MemW[$B000:0]:=M;
    MemW[$B800:0]:=C;
    ProtectiOn:=False;
    GotoXY(1,1);
    ConInPtr1:=ConInPtr;
    ConInPtr:=Ofs(GetCh);
    ConOutPtr1:=ConOutPtr;
    ConOutPtr:=Ofs(PutCh);
  End;

Procedure ProtectOn;                 { Silly procedure to turn on protection }
  Begin
    ProtectiOn:=True;
  End;

Procedure ProtectOff;               { Silly procedure to turn off protection }
  Begin
    ProtectiOn:=False;
  End;

{ Example program -- remove next line to enable }

(*

Var
  I: Integer;
  S: String[80];

Begin
  InitProtect;          { Initialize the protected field emulator }
  ProtectOn;            { Turn on protection }
  ClrScr;               { Clear the screen -- otherwise it's all protected }
  For I:=0 To 1998 Do
   Begin
    If Random(2)=0 Then LowVideo Else HighVideo;
    Write('*');         { Fill the screen with *'s, about 1/2 protected }
   End;
  HighVideo;            { Important!  Otherwise input will be wierd! }
  GotoXY(1,1);
  For I:=1 To 10 Do
   Begin
    ReadLn(S);          { Demonstrate input and output in protected fields }
    WriteLn(S);
   End;
End.
(**)