Columbia Kermit/kermit.zip/lilith/m2misc.mod

Text File | 2020-01-01 | 12KB | 441 lines

IMPLEMENTATION MODULE KermMisc;
(************************************************************************)
(*  This Module contains several service routines                       *)
(*  written:            08.10.85     Matthias Aebi                      *)
(*  last modification:  26.02.85     Matthias Aebi                      *)
(************************************************************************)

IMPORT Terminal;
IMPORT V24;

FROM OutTerminal IMPORT WriteC;
FROM KermParam   IMPORT Packet, LDebug;
FROM TextScreen  IMPORT SetPos, ClearChars;

CONST
    EOL =  36C;
    FF  =  14C;
    ESC =  33C;
    BS  =  10C;
    DEL = 177C;

VAR
    numOfPacks : CARDINAL;    (* Packet counter for status display *)
    numOfTries : CARDINAL;    (* Retry counter for status display *)

(************************************************************************)
                            PROCEDURE ClrScr;
(************************************************************************)
BEGIN
    Terminal.Write(FF);
END ClrScr;


(************************************************************************)
                        PROCEDURE GotoXY(x,y: INTEGER);
(************************************************************************)
BEGIN
    SetPos(y,x);
END GotoXY;


(************************************************************************)
                PROCEDURE SendChar(ch: CHAR; portNr: CARDINAL);
(************************************************************************)
BEGIN
    V24.Write(ch); (* there is only one port on the Lilith *)
END SendChar;


(************************************************************************)
           PROCEDURE RecvChar(VAR ch: CHAR; portNr: CARDINAL): BOOLEAN;
(************************************************************************)
VAR
    gotChar : BOOLEAN;

BEGIN
    V24.BusyRead(ch, gotChar);
    RETURN gotChar;
END RecvChar;


(************************************************************************)
             PROCEDURE ReadString(VAR s: ARRAY OF CHAR);
(************************************************************************)
VAR
    ch : CHAR;
    i  : CARDINAL;

BEGIN
    i := 0;
    REPEAT
        Terminal.Read(ch);
        IF ch = EOL
        THEN
            s[i] := 0C;
            Terminal.Write(ch);
        ELSIF ch = ESC
        THEN
            s[0] := 0C;
            Terminal.WriteLn;
        ELSIF (ch = BS) OR (ch = DEL)
        THEN
            IF i > 0
            THEN
                DEC(i);
                Terminal.Write(ch);
            END;
        ELSE
            s[i] := ch;
            Terminal.Write(ch);
            INC(i);
        END;
    UNTIL (ch = EOL) OR (ch = ESC) OR (i > HIGH(s));
END ReadString;


(************************************************************************)
                 PROCEDURE ReadChar(VAR ch: CHAR): BOOLEAN;
(************************************************************************)
BEGIN
    Terminal.BusyRead(ch);
    IF ch = 0C
    THEN
        RETURN FALSE;
    ELSE
        RETURN TRUE;
    END;
END ReadChar;


(************************************************************************)
                    PROCEDURE InitPort(portNr: CARDINAL);
(************************************************************************)
BEGIN
END InitPort;


(************************************************************************)
        PROCEDURE SetBaud(baudRate: CARDINAL; portNr: CARDINAL);
(************************************************************************)
VAR
    value : CARDINAL;
    dummy : CARDINAL;
    i     : CARDINAL;

(*----------------------------------------------------------------------*)
             PROCEDURE GET(channel: CARDINAL; VAR info: CARDINAL);
(*----------------------------------------------------------------------*)
(* input from channel to info *)
    CODE 240B (* Read *)
END GET;


(*----------------------------------------------------------------------*)
             PROCEDURE PUT(channel: CARDINAL; info: CARDINAL);
(*----------------------------------------------------------------------*)
(* output info to channel *)
    CODE 241B (* Write *)
END PUT;


BEGIN (* SetBaud *)

    (* a CASE  statement would be the right thing to use here but
       the compiler refused it with a 'procedure too long' error !? *)

    IF baudRate = 300
    THEN
        value := 80;
    ELSIF baudRate = 600
    THEN
        value := 96;
    ELSIF baudRate = 1200
    THEN
        value := 112;
    ELSIF baudRate = 2400
    THEN
        value := 160;
    ELSIF baudRate = 4800
    THEN
        value := 192;
    ELSIF baudRate = 9600
    THEN
        value := 224;
    ELSIF baudRate = 19200
    THEN
        value := 240;
    END;

    GET(0, dummy);
    FOR i:=1 TO value DO
        GET(5, dummy);
    END;
    PUT(1,dummy);
END SetBaud;


(************************************************************************)
                   PROCEDURE SendBreak(portNr: CARDINAL);
(************************************************************************)
BEGIN
    Terminal.WriteLn;
    Terminal.WriteString("Sorry, send break is not possible on the Lilith");
    Terminal.WriteLn;
END SendBreak;


(************************************************************************)
                        PROCEDURE WriteChar(ch: CHAR);
(************************************************************************)
VAR
    chrNr : CARDINAL;

BEGIN
    chrNr := ORD(ch);
    IF chrNr < 32
    THEN
        Terminal.Write("^");
        ch := CHR(chrNr + 64);
    END;

    Terminal.Write(ch);
    Terminal.Write(" ");
    Terminal.Write("(");
    WriteC(chrNr,1);
    Terminal.Write(")");
END WriteChar;


(************************************************************************)
                     PROCEDURE AddBits(ch: CHAR): CARDINAL;
(************************************************************************)
VAR
    i     : CARDINAL;
    count : CARDINAL;

BEGIN
    count := 0;
    FOR i:= 0 TO 7 DO
        IF i IN BITSET(ch)
        THEN
            INC(count);
        END;
    END;
    RETURN count;
END AddBits;


(************************************************************************)
                PROCEDURE BitAND(v1,v2: CARDINAL): CARDINAL;
(************************************************************************)
BEGIN
    RETURN CARDINAL(BITSET(v1) * BITSET(v2));
END BitAND;


(************************************************************************)
                PROCEDURE BitOR(v1,v2: CARDINAL): CARDINAL;
(************************************************************************)
BEGIN
    RETURN CARDINAL(BITSET(v1) + BITSET(v2));
END BitOR;


(************************************************************************)
                PROCEDURE BitXOR(v1,v2: CARDINAL): CARDINAL;
(************************************************************************)
BEGIN
    RETURN CARDINAL(BITSET(v1) / BITSET(v2));
END BitXOR;


(************************************************************************)
              PROCEDURE PrtErrPacket(pack: Packet; len: CARDINAL);
(************************************************************************)
BEGIN
    pack[len] := 0C;
    DispMsg(pack);
    (* identify error msg as remote *)
    Terminal.WriteString(" (Remote Kermit)");
END PrtErrPacket;


(************************************************************************)
                   PROCEDURE ToChar(value: CARDINAL): CHAR;
(************************************************************************)
BEGIN
    RETURN CHR(value + 32);
END ToChar;


(************************************************************************)
                    PROCEDURE UnChar(ch: CHAR): CARDINAL;
(************************************************************************)
BEGIN
    IF ORD(ch) >= 32
    THEN
        RETURN ORD(ch) - 32;
    ELSE
        RETURN 0;
    END;
END UnChar;


(************************************************************************)
                        PROCEDURE Ctl(ch: CHAR): CHAR;
(************************************************************************)
BEGIN
    RETURN CHAR(BitXOR(CARDINAL(ch),64));
END Ctl;


(************************************************************************)
             PROCEDURE IncPackNum(packNum: CARDINAL): CARDINAL;
(************************************************************************)
BEGIN
    RETURN (packNum + 1) MOD 64;
END IncPackNum;


(************************************************************************)
             PROCEDURE DecPackNum(packNum: CARDINAL): CARDINAL;
(************************************************************************)
BEGIN
    IF packNum = 0
    THEN
        RETURN 63;
    ELSE

        RETURN packNum - 1;
    END;
END DecPackNum;


(************************************************************************)
                        PROCEDURE DispInit;
(************************************************************************)
(* Initialize the Status Screen                                         *)

BEGIN
    ClrScr;
    SetPos(3,9); Terminal.WriteString("File name:");
    SetPos(4,0); Terminal.WriteString("kBytes transferred:");
    SetPos(6,1); Terminal.WriteString("Number of packets:");
    SetPos(7,1); Terminal.WriteString("Number of retries:");
    SetPos(9,6); Terminal.WriteString("Last message:");

    numOfTries := 0;
    numOfPacks := 0;

    IF LDebug
    THEN
        SetPos(11,0); Terminal.WriteString("Receive Packet:");
        SetPos(19,0); Terminal.WriteString("Send Packet:");
    END;
END DispInit;


(************************************************************************)
                        PROCEDURE DispTry;
(************************************************************************)
(* Display total number of retries                                      *)

BEGIN
    INC(numOfTries);
    SetPos(7,25);
    ClearChars(5);
    WriteC(numOfTries,5);
END DispTry;


(************************************************************************)
                        PROCEDURE DispPack;
(************************************************************************)
(* Display total number of packets                                      *)

BEGIN
    INC(numOfPacks);
    SetPos(6,25);
    ClearChars(5);
    WriteC(numOfPacks,5);
END DispPack;


(************************************************************************)
               PROCEDURE DispFile(fileName: ARRAY OF CHAR);
(************************************************************************)
(* Display name of file                                                 *)

BEGIN
    SetPos(3,25);
    Terminal.WriteString(fileName);
END DispFile;


(************************************************************************)
               PROCEDURE DispMsg(message: ARRAY OF CHAR);
(************************************************************************)
(* Display a message in the status screen                               *)

BEGIN
    SetPos(9,25);
    ClearChars(54);
    Terminal.WriteString(message);
END DispMsg;

(************************************************************************)
  PROCEDURE StringToCard(str: ARRAY OF CHAR; VAR num: CARDINAL): BOOLEAN;
(************************************************************************)
(* convert a numeric string to cardinal. Return TRUE if successful *)
VAR
    i : CARDINAL;

BEGIN
    num := 0;
    i   := 0;

    REPEAT
        IF (str[i] >= "0") AND (str[i] <= "9")
        THEN
            num := 10 * num + ORD(str[i]) - ORD("0");
            i := i + 1;
        ELSE
            num := 0;
            RETURN FALSE;
        END;
    UNTIL (i > HIGH(str)) OR (str[i] = 0C);

    RETURN TRUE;
END StringToCard;


(************************************************************************)
       PROCEDURE CardToString(num: CARDINAL; VAR str: ARRAY OF CHAR);
(************************************************************************)
VAR
    i      : CARDINAL;
    j      : CARDINAL;
    revStr : ARRAY [0..31] OF CHAR;

BEGIN
    i := 0;

    WHILE num > 0 DO
        revStr[i] := CHR(num MOD 10 + ORD("0"));
        num := num DIV 10;
        INC(i);
    END;

    DEC(i);

    FOR j := 0 TO i DO
        str[j] := revStr[i-j];
    END;

    str[i+1] := 0C;

END CardToString;

END KermMisc.