Category : Pascal Source Code
Archive   : QK3KER.ZIP
Filename : QK3SYS.PAS

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) ;
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);
End ; (* case *)

Mono := (GraphDriver=HercMono) or (GraphDriver=EGAMono);
End. (* Sysfunc Unit *)