Columbia Kermit/kermit.zip/norskdata/ndkdco.pas

Pascal/Delphi Source File | 2020-01-01 | 7KB | 218 lines

(* Tab p; *)
procedure   DoCommands;
var     Verb, Noun, Adj : VocabType;
        ParBlock        : ParType;
        FileList        : NListPtr;

    procedure   BgnStat;
    (* Begin registration of statistics *)
    begin(* BgnStst *)
        StartCpTime := xtusd;       (* For description see main VAR-section *)
        StartTime := xtime;         (* (in file Kermit-Vars)                *)
        NChSent := 0L;
        NChRcvd := 0L;
        NChFile := 0L;
    end; (* BgnStst *)

    procedure   EndStat;
    (* End registration of statistics *)
    begin (* EndStat *)
        StopCpTime := xtusd;
        StopTime := xtime;
    end;  (* EndStat *)

    procedure   DoSet( Noun, Adj : VocabType; ParBlock: ParType );

        procedure   DoSRcv( Adj : VocabType; Par: ParType );
        begin(* DoSRcv *)
            case Adj of
                TimeOutSym  :
                    begin
                        RTSet := true;
                        RcvTimeOut := Par.int;
                    end;
            end;
            writeln;
        end; (* DoSRcv *)

        procedure   DoSSend( Adj : VocabType; Par: ParType );
        begin (* DoSSend *)
            case Adj of
                TimeOutSym  :
                    begin
                        STSet := true;
                        SendTimeOut := Par.int;
                    end;
            end;
            writeln;
        end;  (* DoSSend *)

        procedure   DoSetDebug( Adj : VocabType; Par: ParType );
        begin(* DoSetDebug *)
            case Adj of
                OnSym   :
                    begin
                        if Debug then
                            write(' Debug is already on.')
                        else
                            if not DbgConnected then
                                write(' Error: No debug file defined')
                            else
                                Debug := true;
                    end;
                OffSym  :
                    begin
                        if not Debug then
                            write(' Debug was already off.')
                        else
                            Debug := false;
                    end;
                LogFileSym  :
                    begin
                        if DbgConnected then
                            disconnect(DbgOut);
                        (* Add terminator: *)
                        Par.Name.String(.Par.Name.Valid + 1.) := '''';
                        (* Open with Append access *)
                        connect(DbgOut,Par.Name.String,'SYMB','WA',Status);
                        if Status <> 0 then
                            write(' Could not open debug file.')
                        else
                        begin
                            Debug := true;
                            DbgConnected := true;
                            rewrite(DbgOut);
                        end;
                    end;
                NoLogFileSym:
                    begin
                        if not DbgConnected then
                            write(' No debug file open.')
                        else
                        begin
                            disconnect(DbgOut);
                            Debug := false;
                            DbgConnected := false;
                        end;
                    end;
            end;
            writeln;
        end; (* DoSetDebug *)

        procedure   DoS8Quo( Adj : VocabType );
        begin (* DoS8Quo *)
            case Adj of
                AutoSym :   HasSw8Off := false;
                OffSym  :   HasSw8Off := true;
            end;
            writeln;
        end;  (* DoS8Quo *)

        procedure   DoSFWarn( Adj : VocabType );
        begin (* DoSFWarn *)
            case Adj of
                OnSym   :   FileWarning := true;
                OffSym  :   FileWarning := false;
            end;
            writeln;
        end;  (* DoSFWarn *)

    begin (* DoSet *)
        case Noun of
            DbgSym  :   DoSetDebug( Adj, ParBlock );
            DelaySym:
                begin
                    Delay := ParBlock.int;
                    writeln;
                end;
            RcvSym  :   DoSRcv  ( Adj, ParBlock );
            SendSym :   DoSSend ( Adj, ParBlock );
            Use8Sym :   DoS8Quo ( Adj );
            FWarnSym:   DoSFWarn( Adj );
        end;
    end; (* DoSet *)

    procedure   DoStatistics;

        procedure   WrtTimeLN( time : longint );
        begin (* WrtTimeLN *)
            writeln( time div(50L*60L)        :3,' min',
                   (time mod(50L*60L)) div 50L:3,' sec');
        end;  (* WrtTimeLN *)

        procedure   OutInfo( NChF, NChX, NChR, RTime, CPTime, BdRat : longint );
        begin (* OutInfo *)
            writeln('Number of chars. to/from file   :', NChF:5);
            writeln('Number of characters sent       :', NChX:5);
            writeln('Number of characters received   :', NChR:5);
              write('Real time used for transaction  :');
                    WrtTimeLN( RTime );
              write('Computer time used for same     :');
                    WrtTimeLN( CPTime );
              write('Effective baud rate to/from file:', BdRat:5,' baud');
        end;  (* OutInfo *)

    begin(* DoStatistics *)
        if not HasDone then
        begin
            write(' No transaction has been made yet.');
            writeln;
            OutInfo( 0L, 0L, 0L, 0L, 0L, 0L );
        end
        else
        begin
            writeln;    (* to get new line after command line *)
            OutInfo(    NChFile,
                        NChSent,
                        NChRcvd,
                        StopTime - StartTime,
                        StopCpTime - StartCpTime,
                        NChFile * 10L div( (StopTime-StartTime) div 50L )
                    );
        end;
        writeln;
    end; (* DoStatistics *)

begin (* DoCommands *)
    repeat
        brkm(0);    (* Break on all characters *)
        echom(-1);  (* no echo *)
        GetCmd(Verb,Noun,Adj,ParBlock);
        case Verb of
            ExitSym,QuitSym     :   ;
            HelpSym     :
                begin
                    writeln;
                    DoHelp;
                end;
            RcvSym      :
                begin
                    writeln;
                    DidRcv := true;
                    HasDone := true;
                    BgnStat;
                    CurrState :=
                        ReadSwitch( OutFile, Idev, Odev );
                    EndStat;
                end;
            SendSym     :
                begin
                    writeln;
                    if BuildList( ParBlock.Name, FileList ) then begin
                        writeln(' - Ok');
(*                      ShowList( FileList );       *)
                        DidRcv := false;
                        HasDone := true;
                        BgnStat;
                        CurrState :=
                            SendSwitch( FileList, InFile, Idev, Odev );
                        EndStat;
                    end;
                end;
            SetSym      :   DoSet( Noun, Adj, ParBlock );
            StatisticsSym:  DoStatistics;
        end;
    until ( Verb = ExitSym ) or ( Verb = QuitSym );
end; (* DoCommands *)