Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/MULTIMAP.ZIP/MULTIMAP.BOX

Text File | 1985-10-02 | 13.0 KB | 439 lines

TYPE Int_Rec     = RECORD
                 AX,
                 BX,
                 CX,
                 DX,
                 BP,SI,DI,DS,ES,FLAGS: integer;
                END;

  Valid_pages         =  0..7;
  Valid_Line          =  1..25;
  Valid_Column        =  1..80;
  Map_string          =  String[80];
  Valid_Functionkeys  =  0..40;
  Data_Pointer        =  ^Map_data;
  Pointers            =  record
                          First_field,
                          Last_Field:   Data_Pointer;
                         end;

  Map_Data     = record
                  Previous_field,               (*  Pointers for           *)
                  Next_field : Data_Pointer;    (*   linked list           *)
                  ForeColor,                    (*  Foreground Color       *)
                  BackColor  : Byte;            (*  Background Color       *)
                  Line_Num   : Valid_Line;      (*  Line Number            *)
                  Column_Num : Valid_Column;    (*  Column Number          *)
                  Max_Len    : 0..80;           (*  Maximum Length of data *)
                  Data       : Map_string;      (*  This is the field      *)
                 end; {of record definition }

VAR
    Intregs               :  Int_rec;
    This_Field            :  Data_Pointer;
    Functionkey_Pressed,
     Escape               :  Boolean;
    Functionkey           :  Valid_Functionkeys;
    Pointer_Table         :  Array[Valid_Pages] of Pointers;

(******************************************)
(* Reset the pointers for a page          *)
(* Dispose of all pointers for this page  *)
(******************************************)
Procedure Reset_Page(Page : Valid_Pages);
Begin
 This_Field := Pointer_Table[Page].First_Field;
 If This_Field <> Nil then
 repeat
  Dispose(This_Field^.Previous_Field);
  This_Field := This_Field^.Next_Field;
 Until This_Field = Pointer_Table[Page].Last_Field;
 Pointer_Table[Page].First_Field := Nil;
 Pointer_Table[Page].Last_Field := Nil;
End;

(************************************)
(* Initialize the Pointer Table     *)
(************************************)

Procedure Init_Paging;
Var x : Byte;
Begin
For x := 0 to 7 do
 Begin
  Pointer_Table[x].First_Field := Nil;
  Pointer_Table[x].Last_Field := Nil
 End;
End;

(************************************)
(*   Sets the size of the cursor    *)
(************************************)

Procedure Cursorsize(Start,Stop:Byte);
begin
 With Intregs do
   begin
     ax:=1 shl 8;
     cx:=(Start shl 8) + Stop;
     intr($10,Intregs)
   end
end;

(*************************************)
(*       Shows a given page          *)
(*************************************)

PROCEDURE Displaypage(Pagenumber:Valid_pages);
Begin
   With Intregs DO
        Begin
            ax:= (5 shl 8)+Pagenumber; { ax = function code 5 in the high }
            INTR($10,INTREGS)          { issue interupt for  video_io  }
        End
End;

(********************************************)
(*       Positions cursor on a page         *)
(********************************************)
Procedure Gotolc(  Line    : Valid_Line;
                   Column  : Valid_Column;
                   Page    : Valid_Pages );

Begin
 With Intregs DO
  Begin
   AX := 2 SHL 8;
   BX := (BX and $ff) or (Page SHL 8);
   DX := ((Line-1) shl 8) + Column-1;
   INTR($10,Intregs)
  End
End; { of Gotolc }

(**********************************************)
(*  Writes the string at the cursor position  *)
(*  with the specified colors                 *)
(**********************************************)

Procedure Place(  Txt          : Map_String;
                  Page         : Valid_pages;
                  Foreground,
                  Background   :Byte      );

Var I:Byte;
Begin
  With Intregs DO
    Begin
      BX := BX AND $ff;
      BX := BX OR ( Page SHL 8 );
      If Background IN [0..7] Then Begin
                                    BX := BX AND $FF8F;
                                    BX := Bx OR (Background SHL 4)
                                   End;

      IF Foreground IN [0..31] Then Begin
                                      BX := BX AND $FF70;
                                      IF Foreground>15 THEN BX:=BX OR $80;
                                      Foreground:=Foreground and $0f;
                                      BX := BX OR Foreground
                                    End;
      For I:=1 To Length(Txt) DO
         Begin
          CX := 1;
          AX:= 9 SHL 8 + Ord(Txt[I]);
          INTR($10,Intregs);         (* Write one character *)
          AX:=3 SHL 8;
          INTR($10,Intregs);         (* Get cursor Position *)
          DX:=DX+1;                  (* Add one column      *)
          AX:=2 SHL 8;
          INTR($10,Intregs)          (* Move cursor         *)
         END
    End { of with Intregs}
End;

(**********************************************)
(*   Write a string on a page                 *)
(**********************************************)
Procedure Map( Txt         :  Map_string;
               Page        :  Valid_Pages;
               Line        :  Valid_Line;
               Column      :  Valid_Column;
               Foreground,
               Background  :  byte );

 Begin
    Gotolc(Line,Column,Page);
    Place(Txt,Page,Foreground,Background)
 End;


 PROCEDURE MAPU( Txt         :  Map_string;
                 Page        :  Valid_Pages;
                 Line        :  Valid_Line;
                 Column      :  Valid_Column;
                 Foreground,
                 Background  :  byte );
     BEGIN
      map(Txt,Page,Line,Column,Foreground,Background);
      new(This_Field);
      If Pointer_Table[Page].First_Field=nil then
       begin
         Pointer_Table[Page].First_Field:=This_Field;
         Pointer_Table[Page].Last_Field:=This_Field
       end;
      with This_Field^ do
        begin
         Forecolor      := Intregs.BX and $008F;
         Backcolor      := (Intregs.BX and $70) shr 4;
         Line_Num       := Line;
         Column_Num     := Column;
         Max_Len        := length(Txt);
         Data           := '';
         Next_Field     := Pointer_Table[Page].First_Field;
         Previous_Field := Pointer_Table[Page].Last_Field;
         Pointer_Table[Page].Last_Field := This_Field;
         If Previous_Field<>This_Field then
           Previous_Field^.Next_Field := This_field;
         Pointer_Table[page].First_Field^.Previous_Field := This_Field;
       end;
     END;

Procedure Clearpage(Page,
                    Color : Valid_Pages);
Begin
Gotolc(1,1,Page);
With Intregs DO
  Begin
   CX := 2000;
   BX := (Page SHL 8) + (Color shl 4) ;
   If Color = 0  then BX := BX + 7;     (* Eliminates Black on Black *)
   AX := (9 SHL 8)+32;
   INTR($10,INTREGS);
  END;
END;

Function Get_Data( Page  : Valid_Pages;
                   Field : Byte)
                                 : Map_String;
Var Hold : String[2];
    x    : Integer;

Begin
 This_Field := Pointer_Table[Page].First_field;
 If This_Field=Nil then begin
                         Clrscr;
                         Str(Page,Hold);
                         map('Error locating data for page ' +hold,page,1,1,red,black);
                        end
 Else
 Begin
  For x:= 1 to Field-1 do
     This_Field:= This_Field^.Next_Field;

  With This_Field^ do Get_Data :=Data;
 End;
End; {of Data Function}


PROCEDURE ReadMap( Page:Valid_Pages;   (* Page number to be processed *)
                   Start:Integer);     (* Position cursor at the Nth field *)

VAR Return:BOOLEAN;A:CHAR;X,Y:INTEGER;

Procedure Get_Starting_Field( Page:Valid_Pages;
                              Start:Integer);
Var hold:String[2];
Begin
 This_Field := Pointer_Table[Page].First_field;
 If This_Field=Nil then begin
                         Clrscr;
                         Str(Page,Hold);
                         map('Error locating data for page ' +hold,page,1,1,red,black);
                        end
 Else
 Begin
  For x:= 1 to Start-1 do
     This_Field:= This_Field^.Next_Field;

  With This_Field^ do
   Begin
    Textcolor(Forecolor);
    TextBackground(Backcolor);
    GotoLC(Line_Num,Column_Num,Page);
   end;
 End;
End; {of Get_Starting_Field}

Procedure Get_Cursor_Position;
Begin
With Intregs do
Begin
  AX := 3 shl 8;
  BX := Page shl 8;
  Intr($10,Intregs);
  x:= (DX and $00FF)+1;
  y:= ( (DX and $FF00) shr 8) +1;
End;
End;

Procedure BackTab;
 Begin
  Get_Cursor_Position;
  With This_Field^ do If x = Column_Num then This_Field := Previous_Field;
  With This_Field^ do GotoLC(Line_Num,Column_Num,page)
 end;

Procedure Goto_Next_Field;
Begin
  This_Field := This_Field^.Next_field;
  With This_Field^ DO GotoLC(Line_Num,Column_num,Page);
End;

Procedure Write_Char;
Begin
Get_Cursor_Position;
With This_Field^ do
  begin
   map(A,Page,y,x,Forecolor,Backcolor);
   Data[x-Column_Num+1] := a;
   If x-Column_Num+1 > Length(Data) then
       Data[0] := chr(Length(data) + 1);
   If x+2 > Column_Num+Max_Len then Goto_Next_Field;
  end;
End;

Procedure Set_Functionkey;                (* Regular Function Keys  F1  - F10 *)
Begin                                     (* Shift + Function Key = F11 - F20 *)
 Functionkey_Pressed := True;             (* Ctrl + Function Key  = F21 - F30 *)
  Case Ord(A) of                          (* Alt + Functionkey    = F31 - F40 *)
   59..68  : Functionkey := Ord(A)-58;
   84..113 : Functionkey := Ord(A)-73;
  End;
End;

Procedure Get_Extended_Code;
Begin
 Read(Kbd,A);
 Case Ord(A) of
  59..68,84..113: Set_Functionkey;

  75 : { Left Arrow }
       Begin
         Get_Cursor_Position;
         If x > This_Field^.Column_Num then
                Begin
                  x := x-1;
                  GotoLc(y,x,Page);
                End
           Else BackTab;
       End;

  77 : { Right Arrow }
       Begin
         Get_Cursor_Position;
         With This_Field^ DO
            If x+2 > Column_Num + Max_Len Then Goto_Next_Field
               Else GotoLC(y,x+1,Page);
       End;

  80 : { Down Arrow }
       Begin
         Repeat
           If This_Field^.Line_Num = This_Field^.Next_Field^.Line_Num
              then This_Field := This_Field^.Next_Field;
         Until (This_Field^.Line_num <> This_Field^.Next_Field^.Line_Num)
            or (This_Field = Pointer_Table[Page].Last_Field);
         Goto_Next_Field;
       End;

  72 : { Up Arrow }
       Begin
         Repeat
           This_Field := This_Field^.Previous_Field;
         Until (This_Field^.Line_Num <> This_Field^.Next_Field^.Line_Num)
           or (This_Field = Pointer_Table[Page].Last_Field);
         Repeat
           This_Field := This_Field^.Previous_Field;
         Until (This_Field^.Line_Num <> This_Field^.Next_Field^.Line_Num)
           or (This_Field = Pointer_Table[Page].Last_Field);
         Goto_Next_Field;
       End;


  15 : {Left Tab}
       Begin
         This_Field := This_Field^.Previous_Field;
         With This_Field^ DO GotoLC(Line_Num,Column_Num,Page);
       End;

  71 : { Home }
       Begin
         This_Field := Pointer_Table[Page].First_Field;
         With This_Field^ DO GotoLC(Line_Num,Column_Num,Page);
       End;

  79 : { End }
       Begin
         This_Field := Pointer_Table[Page].Last_Field;
         With This_Field^ DO GotoLC(Line_Num,Column_Num,Page);
       End;

  82 : { Insert }
       Begin
         Get_Cursor_Position;
         With This_Field^ do
         Begin
           Insert(' ',Data,x-Column_Num+1 );
           If Length(Data) > Max_Len then Data[0] := Chr(Max_Len);
           map(Data,Page,Line_Num,Column_Num,Forecolor,Backcolor);
         End;
         GotoLc(y,x,page);
       End;

  83 : { Delete }
       Begin
          Get_Cursor_Position;
          With This_Field^ do
          Begin
            Delete(Data,x-Column_Num+1,1);
            Insert(' ',Data,Length(data)+1);
            map(Data,Page,Line_Num,Column_Num,Forecolor,Backcolor);
            Delete(data,Length(data),1);
          End;
          GotoLc(y,x,page);
       End;


 end; { of cases }
End;

BEGIN                (***** This is the real start of Readmap  ***********)
 Displaypage(page);  (* Ensures correct display *)
 Return := False;
 Functionkey_Pressed := False;
 Functionkey := 0;
 Escape := False;
 Get_Starting_Field(Page,Start);
 REPEAT

  READ(KBD,A);
  case ord(a) of
    8: BackTab;
    9: {Right Tab}
       Begin
        This_Field := This_Field^.Next_Field;
        With This_Field^ DO GotoLC(Line_Num,Column_Num,Page);
       End;
   13: {Return Key} Return := True;
   Else
    If Ord(A) in [32..126] then write_char
      Else
       If (Ord(A) = 27) and (not Keypressed) then Escape := True
         Else Get_Extended_Code;
  End; { of cases }
 Until Return or Functionkey_Pressed or Escape;
END;    {Of ReadMap Procedure}