[Back to COMM SWAG index] [Back to Main SWAG index] [Original]

    {
    After quite some time of working on fossil routines, and using examples
    from the swag, I've come up with this unit for interfacing with the modem.
    However, on testing it remotely, the display doesn't appear the same as
    the local one.    Is there anyone who can help with this one?

    I'm real stuck on this....and would LOVE it if someone could help me.

    Thanks,
    ±±²²°° David Reilly °°²²±±
    dodo@rip.it.bond.edu.au

    }
    Unit FossilDrv;

    interface

    Uses Crt;

    Type
        Colours = (Black, Red, Green, Brown, Blue, Magenta, Cyan, LightGrey,
                   Grey, BrightRed, BrightGreen, Yellow, BrightBlue,
                   BrightMagenta, BrightCyan, BrightWhite);

    Var
       Local : BOOLEAN;

    Procedure Colour ( Col : Colours);      { Changes colour (both locally and
                                              remotely), by sending ansi codes
                                              and changing text colour }
    procedure WriteChar ( c : char );       { Writes a character directly to the
                                              comport }
    procedure WriteLine;                    { Writes a <CR> to the comport }
    procedure WriteString ( s : string );   { Writes a string to the comport }
    procedure WriteInt ( number : integer );{ writes an integer to the comport }

    procedure ReadChar ( VAR c : char );    { Reads a character, either locally
                                              or from comport }
    procedure ReadString ( VAR s : string); { Reads a string, either locally or
                                              from comport }
    procedure ReadInt ( VAR number:integer);{ reads an integer from the comport }
    procedure Init ( port : byte);          { Initialises DLSFos routines }
    procedure Finish;                       { De-initialises DLSFos routines}
    function  Carrier:boolean;              { TRUE if Carrier detected }

    procedure Goto_XY ( X, Y : integer);    { Goto position X, Y on ansi }
    procedure Home;                         { Clears screen }
    procedure Comm_Tx(sendbyte:byte);       { Send a byte to port }
    function  Comm_Rx_Ready:boolean;        { TRUE if char waiting in buffer }
    function  Comm_Rx:byte;                 { Get a byte from port }

    implementation

    var Comm_Port:word;{Port to use, in FOSSIL format. ie. COM1=0}
        StatBit:Word;{Status Bit}

    function OpenFos(port:byte):boolean;
    var t:word;
    begin
         Comm_Port:=port-1;
         asm
            mov ah, 4h
            mov dx, Comm_Port
            int 14h
            mov t, ax
         end;
         OpenFos:=t=$1954
    end;

    procedure CloseFos;
    begin
         asm
            mov ah, 5h
            mov dx, Comm_Port
            int 14h
         end;
    end;

    procedure Comm_Baud(baud:word);
    var Newbaud:byte;
    begin
         Case Baud div 10 of        {finds the bit value version of the baud}
              30:  Newbaud:=$43;
              60:  Newbaud:=$63;
              120: Newbaud:=$83;
              240: Newbaud:=$A3;
              480: Newbaud:=$C3;
              960: Newbaud:=$E3;
              1920:Newbaud:=$03;
              3840:Newbaud:=$23;
       end;
         asm
            mov ah, 0h
            mov al, Newbaud
            mov dx, Comm_Port
            int 14h
         end;
    end;

    function Carrier:boolean;
    begin
         asm
            mov ah, 3h
            mov dx, Comm_Port
            int 14h
            mov StatBit, ax
         end;
         Carrier:=(StatBit and 128) <> 0;      {Bit 7=CD Signal}
    end;

    procedure Comm_Tx(sendbyte:byte);
    begin
         asm
            mov ah, 1h
            mov al, SendByte
            mov dx, Comm_Port
            int 14h
         end;
    end;

    function  Comm_Rx_Ready:boolean;
    begin
         asm
            mov ah, 3h
            mov dx, Comm_Port
            int 14h
            mov StatBit, ax
         end;
         Comm_Rx_Ready:=(StatBit and $100) <> 0;{Bit 0 of AH!}
    end;

    function  Comm_Rx:byte;
    var temp:byte;
    begin
         asm
            mov ah, 2h
            mov dx, Comm_Port
            int 14h
            mov temp, al
         end;
         Comm_Rx:=temp;
    end;

    Procedure WriteChar ( C : CHAR );
    BEGIN
         if c = chr(13) then writeln
         else Write(C);
         IF Not(Local) THEN Comm_Tx ( ORD ( C ) ); { if remote, then print remote
    }end;

    Procedure WriteLine;
    Begin
         If not(local) then Comm_Tx (13); { CARRIAGE RETURN }
         Writeln;
    end;

    Procedure WriteString ( S : String );
    VAR
     I : Integer;
    BEGIN
         FOR I := 1 to Length(S) DO
             WriteChar( S[i] );
    END;

    procedure home;
    begin
         WriteString ('[40m[2J');
         ClrScr;
    end;

    Procedure ReadChar(VAR C : CHAR);
    Begin
         IF Not(Local) THEN
         Begin
         REPEAT
         UNTIL Keypressed or Comm_Rx_Ready;
         IF Keypressed THEN C:= Readkey
         ELSE c := CHR(Comm_Rx);
         end
         else
         begin
              repeat
              until keypressed;
              c := Readkey;
         end;
         WriteChar ( C );
    end;

    Procedure Init( port : byte);
    var
       Paramater : String;
    Begin
         Paramater := Paramstr(1);
         Local := FALSE; { by default - unless carrier detected its local }
         if (paramater = 'local') or (paramater = 'LOCAL') THEN
            Local := TRUE
         Else if not(Carrier) then Local := True; { is local login or remote? }

         IF OpenFos( Port ) THEN
            Writeln ('Communications port opened successfully');
         IF Carrier THEN Writeln ('Carrier detected')
         ELSE Writeln ('Carrier not detected');
         Delay (500);

    end;

    Procedure Finish;
    Var
       I : integer;
    Begin
         Write (' Closing communications port ');
         For I := 1 to 5 DO Begin
              Delay (500);
              Write ('.');
         End;
         CloseFos;
    end;

    Procedure ReadString ( VAR S : String);

    Procedure Strip ( VAR g : String );
    { removes 1 char }
    Var L : Integer;
        Temp : string;
    Begin
         temp := '';
         IF Length(g) >1 THEN
         Begin
         For L :=1 TO Length( g)-1 DO
             Temp := Temp + g[L];
         g := Temp;
         END
         ELSE g := '';
    End;

    VAR
       I : Integer;
       Character : CHAR;

    Begin
         I:= 1;
         S := '';

         REPEAT
               ReadChar (Character);
               INC (I);
               IF Character = CHR(8) THEN Strip(S)
               ELSE IF Character <>Chr(13) THEN S:=S+ Character;
         UNTIL (I=255) or (Character = CHR(13));
    END;

    Procedure WriteInt ( Number : Integer);
    Var
       NumStr : String;

    Begin
       { Convert from number to string }

       Str ( Number, NumStr );

       WriteString ( NumStr );
    End;

    Procedure ReadInt ( VAR Number : Integer);
    Var
       NumStr : String;
       Valid : Integer;

    Begin
         ReadString ( NumStr );
         Val ( NumStr, Number , Valid );
         IF Not( Valid =0) THEN
         BEGIN
              Number := 0;
              WriteChar (Chr(7));
         END;
    end;

    Procedure Goto_XY ( X, Y : Integer);
    VAR
       PosString : String;
       Position : String;
       I : Integer;
    (*   debug : text;*)
    BEGIN
         GotoXY(X,Y);
         if not(Local) THEN BEGIN
         PosString := CHR(27) + '[';

         Str(Y, Position);
         PosString := PosString+ Position +';';
         Str(X, Position);
         PosString := PosString + Position +'f';
    (*     repeat
         until keypressed;
         assign (debug, 'debug.ans');
         append (debug);
         write (debug, posstring);
         close(debug);*)
         FOR I := 1 to Length(PosString) DO
             Comm_Tx ( ORD (PosString[i] ) ); { Print each character of ANSI
    sequence }     END; { Remote at X,Y }
    end;

    Procedure Colour ( Col : Colours);
    {    Colours = (Black, Red, Green, Brown, Blue, Magenta, Cyan, LightGrey,
                   Grey, BrightRed, BrightGreen, Yellow, BrightBlue,
                   BrightMagenta, BrightCyan, BrightWhite);}

    Var
       ColourString : string;
       i : Integer;

    Begin
         { Process local colour change }
         CASE Col   of
              { Low intesity colours}

              Black  : TextColor(0);
              Red    : TextColor(4);
              Green  : TextColor(2);
              Brown  : TextColor(6);
              Blue   : TextColor(1);
              Magenta: TextColor(5);
              Cyan   : TextColor(3);
              LightGrey : TextColor(7);

              { High intensity colours }
              Grey          : TextColor(8);
              BrightRed     : TextColor(12);
              BrightGreen   : TextColor(10);
              Yellow        : TextColor(14);
              BrightBlue    : TextColor(9);
              BrightMagenta : TextColor(13);
              BrightCyan    : TextColor(11);
              BrightWhite   : TextColor(15);

         end;

         IF not(Local) THEN BEGIN
         ColourString := CHR(27) + '['; { 27 = esc }
         CASE Col   of
              { Low intesity colours}
              Black  : ColourString := ColourString + '0;30m';
              Red    : ColourString := ColourString + '0;31m';
              Green  : ColourString := ColourString + '0;32m';
              Yellow : ColourString := ColourString + '0;33m';
              Blue   : ColourString := ColourString + '0;34m';
              Magenta: ColourString := ColourString + '0;35m';
              Cyan   : ColourString := ColourString + '0;36m';
              LightGrey : ColourString := ColourString + '0;37m';

              { High intensity colours }
              Grey          : ColourString := ColourString + '1;30m';
              BrightRed     : ColourString := ColourString + '1;31m';
              BrightGreen   : ColourString := ColourString + '1;32m';
              Yellow  : ColourString := ColourString + '1;33m';
              BrightBlue    : ColourString := ColourString + '1;34m';
              BrightMagenta : ColourString := ColourString + '1;35m';
              BrightCyan    : ColourString := ColourString + '1;36m';
              BrightWhite   : ColourString := ColourString + '1;37m';

         end;
    {     WriteString (ColourString);  (* Prob. ansi written to local term *)}
         FOR I := 1 to Length(ColourString) DO
             Comm_Tx ( ORD ( ColourString[i] ) ); { Print each character }

         END; { finish remote ANSI colour change }
    end;

    end. {Unit}

[Back to COMM SWAG index] [Back to Main SWAG index] [Original]