[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]