Columbia Kermit/kermit.zip/perqb/pq2scr.pas

Pascal/Delphi Source File | 2020-01-01 | 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.
{=============================================================================}