Unit Sysfunc ;
(* ================================================================= *)
(*  MsDos SYSTEM  dependent Routines for Kermit .                    *)
(* ================================================================= *)
Interface
    Uses Dos,Crt,Graph,     (* Standard Turbo Pascal Units *)
    KGlobals,modempro ;
TYPE
    ScreenArray = array [0..3999] of byte ;
Var
    RealScreen      : ^ScreenArray ;
    GraphDriver,Graphmode : integer ;
    margintop,marginbot : byte ;
(* Functions & Procedures *)
    Function KeyChar (var Achar,Bchar : byte): boolean ;
    Procedure CursorUp ;
    Procedure CursorDown ;
    Procedure CursorRight ;
    Procedure CursorLeft ;
    Procedure Scroll(updown,top,bottom:byte);
    Procedure FatCursor(flag :boolean);
    Procedure RemoteScreen ;
    Procedure LocalScreen ;
    Procedure SetDefaultDrive (Drive : Byte);
    Function DefaultDrive : Byte ;

(* ================================================================= *)
Implementation
CONST
    (* FLAGS in flag register *)
    Cflag = $0001 ;
    Pflag = $0004 ;
    Aflag = $0010 ;
    Zflag = $0040 ;
    Tflag = $0100 ;
    Iflag = $0200 ;
    Dflag = $0400 ;
    Oflag = $0800 ;

VAR
    RemSaveX,RemSaveY,LocSaveX,LocSaveY : integer ;
    SaveLocalScreen  : ^ScreenArray  ;
    SaveRemoteScreen : ^ScreenArray  ;
    register  : registers ;
    NumLock,ScrollLock : byte ;
    Mono : boolean ;
    i : integer ;
(* ------------------------------------------------------------------ *)
(* KeyChar - get a character from the Keyboard.                       *)
(*           It returns TRUE if character found and the char is       *)
(*           returned in the parameter.                               *)
(*           It returns FALSE if no keyboard character.               *)
(*                                                                    *)
(* ------------------------------------------------------------------ *)
    Function KeyChar (var Achar,Bchar : byte): boolean ;
    Begin (* KeyChar *)
    with register do
           begin
           ah := 1;
           intr($16,register);
           if (Zflag and flags)=Zflag then

(* ------ The following code is required only if we want to us the ----- *)
(* ------ NUMLOCK and SCROLLLOCK key as function keys  ----------------- *)
              begin (* check for Numlck and Scroll Lck *)
              ah := 2;
              intr($16,register);
              If  (al and $10) <> ScrollLock then
                   Case (al and $0F) of
                   0:     Bchar := $46 ; (* not shifted *)
                   1,2,3: Bchar := $86 ; (* shifted *)
                   4,5,6,7: Bchar := $87 ; (* control *)
                   else Bchar := $87 ; (* Alt *)
                   end  (* case *)
                                            else
              If  (al and $20) <> NumLock then
                   Case (al and $0F) of
                    0:     Bchar := $45 ; (* not shifted *)
                    1,2,3: Bchar := $85 ; (* shifted *)
                    4,5,6,7: Bchar := $88 ; (* control *) (* Not Available *)
                    Else Bchar := $88 ; (* Alt *)
                   End (* case *)
                                             else Bchar := 0 ;
              ScrollLock := (al and $10) ;
              NumLock := (al and $20) ;
              Achar := 0 ;
              If Bchar <> 0 then   KeyChar := true
                            else   KeyChar := false
              End   (* check for Numlck and Scroll Lck *)
(*------ If you don't need this code, replace it with ------------------ *)
(* --------   KeyChar := False ----------------------------------------- *)
                                     else
              begin
              ah := 0;
              intr($16,register);
              Achar := al ;
              Bchar := ah ;
              KeyChar := true;
              end ;
           end;
    End ; (* KeyChar *)

(* ------------------------------------------------------------------ *)
(* CursorUp -                                                         *)
(* ------------------------------------------------------------------ *)
    Procedure CursorUp ;
    Begin (* CursorUp *)
    If margintop <> WhereY then GotoXY(WhereX,WhereY-1);
    End;  (* CursorUp *)

(* ------------------------------------------------------------------ *)
(* CursorDown -                                                       *)
(* ------------------------------------------------------------------ *)
    Procedure CursorDown ;
    Begin (* CursorDown *)
    If marginbot <> WhereY then GotoXY(WhereX,WhereY+1);
    End;  (* CursorDown *)

(* ------------------------------------------------------------------ *)
(* CursorRight -                                                      *)
(* ------------------------------------------------------------------ *)
    Procedure CursorRight ;
    Begin (* CursorRight *)
    GotoXY(WhereX+1,WhereY);
    End;  (* CursorRight *)

(* ------------------------------------------------------------------ *)
(* CursorLeft -                                                       *)
(* ------------------------------------------------------------------ *)
    Procedure CursorLeft ;
    Begin (* CursorLeft *)
    GotoXY(WhereX-1,WhereY);
    End;  (* CursorLeft *)
(* ------------------------------------------------------------------ *)
(* Scroll - Scrolls a section of screen up or down.                   *)
(* ------------------------------------------------------------------ *)
    Procedure Scroll(updown,top,bottom:byte);
    Begin (* Scroll  *)
    With register do
         begin (* Scroll up *)
         ch := top  ;   cl := 0 ;      (*   top right hand corner *)
         dh := bottom ; dl := 79 ;     (* bottom left hand corner *)
         bh := $07 ;                   (* blank line attribute *)
         al := 1 ;                     (* number of line to scroll *)
         ah := updown ;  (* Function code 6 - Scroll up   *)
                         (* Function code 7 - Scroll down *)
         intr($10,register);
         end (* Scroll *)
    End;  (* Scroll *)

(* ------------------------------------------------------------------ *)
(* FatCursor -                                                       *)
(* ------------------------------------------------------------------ *)
    Procedure FatCursor(flag :boolean);
    Begin (* FatCursor *)
    With register do
         begin (* Cursor size *)
         if Mono then cl := 12
                 else cl := 7 ;
         if flag then ch := 1
                 else if Mono then ch := 11
                              else ch := 6 ;
         ah := 1;  (* Function code 1 - Select cursor type  *)
         intr($10,register);
         end ; (* Cursor size *)
    End;  (* FatCursor *)

(* ------------------------------------------------------------------ *)
(* RemoteScreen - Procedure                                           *)
(*                This procedure save the local screen and restores   *)
(*                the remote screen.                                  *)
(*                Also setup the 25th line to display settings        *)
(* ------------------------------------------------------------------ *)
    Procedure RemoteScreen ;
    var i : integer ;
    Begin (* RemoteScreen *)
    LocSaveX := whereX ; LocSaveY := whereY ;  (* Save local cursor *)
    SaveLocalScreen^ := RealScreen^ ;   (* Save local Screen *)
    RealScreen^ := SaveRemoteScreen^ ;   (* Switch Screens *)
    if Line25Flag then
         begin  (* ---- set up 25th line with status ------ *)
         GotoXY(1,25);
         If Mono then
              Begin Textcolor(Black) ; Textbackground(White); end
                 else
              Begin Textcolor(Blue); Textbackground(Yellow); end ;
         Write  (' Port ');
         If PrimaryPort then Write('One : ')
                        else Write('Two : ');
         Write(Baudrate,' baud, ');
         Case paritytype(parity) of
             OddP : write('Odd  ');
             EvenP: write('Even ');
             MarkP: write('Mark ');
             NoneP: write('None ');
         end ; (* parity case *)
         Write('parity, ');
         If LocalEcho then Write('Half duplex, ')
                      else Write('Full duplex, ');
         If XonXoff then write('IBM-Xon  ')
                    else if NoEcho then write('NoEcho   ')
                                   else write('Standard ');
         Write  ('    ExitChar=CTL ',chr($5C),'   ' ) ;
         Textcolor(LightGray); Textbackground(0);
         end   (* ---- set up 25th line with status ------ *)
                 else
         begin (* clear 25th line *)
         Textcolor(White) ;  Textbackground(0) ;
         GotoXY(1,25);
         write(' ':79);
         End ;  (* clear 25th line *)
         (* -------------------------------------------- *)
    Window(1,1,80,24);
    GotoXY(RemSaveX,RemSaveY);
    End;  (* RemoteScreen *)

(* ------------------------------------------------------------------ *)
(* LocalScreen  - Procedure                                           *)
(*                This procedure save the remote screen and restores  *)
(*                the local  screen.                                  *)
(* ------------------------------------------------------------------ *)
    Procedure LocalScreen ;
    Begin (* LocalScreen *)
    RemSaveX := whereX ; RemSaveY := whereY ;  (* Save Remote Cursor *)
    SaveRemoteScreen^ := RealScreen^ ;   (* Save Remote Screen *)
    RealScreen^ := SaveLocalScreen^ ;    (* Restore Local Screen *)
    TextColor(Yellow); TextBackground(Black);
    Window(1,1,80,25);
    GotoXY(LocSaveX,LocSaveY);
    End;  (* LocalScreen *)
(* ------------------------------------------------------------------ *)
(* SetDefaultDrive -                                                  *)
(* ------------------------------------------------------------------ *)
    Procedure SetDefaultDrive (Drive : Byte);
    Begin (* SetDefaultDrive *)
    With register do
         begin (* Select disk *)
         DL := Drive ;
         Ax := $0E00 ;      { Select default drive }
         MsDos(Register);
         end; (* Select disk *)
    End;  (* SetDefaultDrive *)

(* ------------------------------------------------------------------ *)
(* DefaultDrive - returns the value of the default drive              *)
(*                 A=0,B=1,C=2 etc.                                   *)
(* ------------------------------------------------------------------ *)
    Function DefaultDrive : Byte ;
    Begin (* DefaultDrive *)
    With register do
         begin (* Current disk *)
         Ax := $1900 ;      { Find default drive }
         MsDos(Register);
         DefaultDrive := al ;
         end; (* Current disk *)
    End;  (* DefaultDrive *)
(* ----------------------------------------------------------------- *)
Begin (* Sysfunc Unit *)
new(SaveRemoteScreen);
new(SaveLocalScreen) ;
RemSaveX := 1 ;
RemSaveY := 1 ;
For i:= 0 to 1999 do
    Begin (* Clear out SaveRemoteScreen *)
    SaveRemoteScreen^[i*2] := $20 ; (* Blank Character *)
    SaveRemoteScreen^[i*2+1] := $07 ; (* light Gray on Black *)
    End ;(* Clear out SaveRemoteScreen *)
DetectGraph(GraphDriver,GraphMode);
   Case GraphDriver of
     CGA : RealScreen := PTR($B800,0000);
    MCGA : RealScreen := PTR($B800,0000);
     EGA : RealScreen := PTR($B800,0000);
   EGA64 : RealScreen := PTR($B800,0000);
  EGAMono: RealScreen := PTR($B800,0000);
HercMono : RealScreen := PTR($B000,0000);
  ATT400 : RealScreen := PTR($B800,0000);
     VGA : RealScreen := PTR($B800,0000);
  PC3270 : RealScreen := PTR($B800,0000);
  else     RealScreen := PTR($B000,0000);
    End ; (* case *)

 Mono := (GraphDriver=HercMono) or
         (GraphDriver=EGAMono) or
         (RealScreen =PTR($B000,0000)) ;

End. (* Sysfunc Unit *)