home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
perqb.tar.gz
/
perqb.tar
/
pq2scr.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-06-06
|
8KB
|
291 lines
module KermitScreen;
{=============================} exports {=====================================}
imports KermitGlobals from KermitGlobals;
const
MessageWindow = 1;
MainWindow = 2;
TermWindow = 3;
ProgrWindow = 4;
StatusWindow = 5;
KermitFont = 'sys:Boot>Fix13N.Kst';
type WinType = MessageWindow..StatusWindow;
procedure PutMessage( ErrMsg : String );
procedure PutChr( Ch : Char );
procedure BackSpace( Ch : Char );
procedure SwitchWindow( ToWindow : WinType );
procedure CurrentWindow( Var InWindow : WinType );
procedure InitScreen;
procedure CleanupScreen;
procedure InitTermScreen;
procedure CleanupTermScreen;
procedure InitProgress;
procedure ShowSRFile( Send : boolean;
var Fname1,
Fname2 : PString );
procedure ShowPackNum;
{==============================} private {===================================}
imports PopUp from PopUp;
imports Screen from Screen;
imports System from System;
imports IOUtils from IOUtils;
const MaxHeight = 1023; { Number of Pixels }
CWinHeight = 90;
CWinBegY = MaxHeight - CWinHeight;
SWinHeight = 130;
SWinBegY = 0;
PWinHeight = SWinHeight;
PWinBegY = SWinBegY;
TWinHeight = 400;
TWinBegY = SWinHeight;
MWinBegY = TWinBegY + TWinHeight;
MWinHeight = CWinBegY - MWinBegY;
FullWidth = 768;
SWinWidth = 300;
SWinBegX = FullWidth - SWinWidth;
PWinWidth = FullWidth - SWinWidth;
PWinBegX = 0;
PTopM = 20;
PLeftM = 10;
Frame = 5;
var
CurrFont : FontPtr;
MessY, PackY, RetrY, File1Y, File2Y,
LeadX, ValX, Fwidth, Fheight, FChars : integer;
{=============================================================================}
procedure SwitchWindow( ToWindow:WinType );
begin
ChangeWindow( ToWindow );
end;
{=============================================================================}
procedure CurrentWindow( VAR InWindow:WinType );
var D1,D2,D3,D4 : integer; { Dummy variables for the window parameters }
D5 : boolean; { in which we are not interested. }
Win : WinRange;
begin
GetWindowParms( Win, D1, D2, D3, D4, D5 );
InWindow := Win; { Note the type conversion: Screen is not re-exported. }
end;
{=============================================================================}
procedure PutMessage(ErrMsg:String);
var SaveWin : WinType;
begin
CurrentWindow( SaveWin );
ChangeWindow( MessageWindow );
writeln(ErrMsg);
ChangeWindow(SaveWin);
end; { PutMessage }
{=============================================================================}
procedure PutChr( Ch : Char );
begin
SPutChr( Ch );
end;
{=============================================================================}
procedure BackSpace( Ch : Char );
begin
SBackSpace( Ch );
end;
{=============================================================================}
procedure InitProgress;
var OldWin : WinType;
OrgX, OrgY, Width, Height : integer;
WindX : WinRange;
HasTitle : boolean;
begin
CurrentWindow( OldWin );
SwitchWindow( ProgrWindow );
GetWindowParms( WindX, OrgX, OrgY, Width, Height, HasTitle );
CurrFont := GetFont;
PutChr( FF );
FHeight := CurrFont^.Height;
FWidth := CurrFont^.index[ord(' ')].Width; { Assume fixed width font }
LeadX := OrgX + PLeftM;
FChars := ((PWinWidth - LeadX - Frame) DIV FWidth) - 12;
ValX := LeadX + 20*FWidth;
MessY := OrgY + PTopM;
PackY := MessY + 2*FHeight;
RetrY := PackY + FHeight;
File1Y := RetrY + round( 1.5*FHeight );
File2Y := File1Y + FHeight;
SSetCursor( LeadX, MessY );
write( KermitMessage );
SSetCursor( LeadX, PackY );
write( 'Packet number : ' );
SSetCursor( LeadX, RetrY );
write( 'Retries : ' );
SwitchWindow( OldWin );
end;
{=============================================================================}
procedure ShowSRFile( Send : boolean;
VAR Fname1,
Fname2 : FNameType );
var OldWin : WinType;
Test1,Test2 : PString;
procedure OutFName( F : FNameType );
var SS : FNameType;
L : Integer;
begin
if Length(F)>FChars then begin
L := (FChars-5) DIV 2;
SS := SubStr( F, 1, L );
write( SS, '.....' );
SS := SubStr( F, Length(F)-L, L );
write(SS);
end else
write(F);
end;
begin
CurrentWindow( OldWin );
SwitchWindow( ProgrWindow );
CurrFont := GetFont;
RasterOp( RXor, PWinWidth-LeadX-Frame, Trunc(FHeight*2.5),
LeadX, File1Y-FHeight, SScreenW, SScreenP,
LeadX, File1Y-FHeight, SScreenW, SScreenP );
SSetCursor( LeadX, File1Y );
if Send then
write( 'Sending : ')
else
write( 'Receiving : ');
OutFName( Fname1 );
Test1 := FName1;
Test2 := FName2;
if (Fname2<>'') and (Test1<>Test2) then begin
SSetCursor( LeadX, File2Y );
write( 'Perq file : ');
OutFName( Fname2 );
end;
SwitchWindow( OldWin );
end;
{=============================================================================}
procedure ShowPackNum;
var OldWin : WinType;
begin
CurrentWindow( OldWin );
SwitchWindow( ProgrWindow );
SSetCursor( ValX, PackY );
write( NN:4 );
SSetCursor( ValX, RetrY );
write( TotTry:4 );
SwitchWindow( OldWin );
end;
{=============================================================================}
procedure InitScreen;
var f : fontPtr;
begin
ScreenReset;
CreateWindow( MessageWindow,
0, { x-origin }
CWinBegY,
FullWidth,
CWinHeight,
'Messages');
CreateWindow( MainWindow,
0, { x-origin }
MWinBegY,
FullWidth,
MWinHeight,
'Kermit-Perq');
CreateWindow( TermWindow,
0,
TWinBegY,
FullWidth,
TWinHeight,
'Remote Kermit');
CreateWindow( StatusWindow,
SWinBegX,
SWinBegY,
SWinWidth,
SWinHeight,
'Line parameters');
CreateWindow( ProgrWindow,
PWinBegX,
PWinBegY,
PWinWidth,
PWinHeight,
'Transmit progress');
ChangeWindow(TermWindow);
f := ReadFont(KermitFont);
if f=NIL then begin
ChangeWindow(MainWindow);
writeln('Can''t find font file ',KermitFont,' - aborted!');
raise ExitProgram;
end;
ChangeWindow(MainWindow);
end { InitScreen };
{=============================================================================}
procedure CleanupScreen;
begin
ScreenReset;
end;
{=============================================================================}
procedure InitTermScreen;
begin
ChangeWindow( TermWindow );
IOCursorMode( TrackCursor );
SCurChr( '_' );
SCurOn;
InitPopUp;
end;
{=============================================================================}
procedure CleanupTermScreen;
begin
ChangeWindow( MainWindow );
end.
{=============================================================================}