{********************************************************************
 ***                                                              ***
 ***                      SERIAL PORT DEVICE                      ***
 ***                                                              ***
 ********************************************************************}
{$I compflgs}
{Provides a serial port descendant of TDeviceStream, using routines
provided in doscom.pas, 3rd party interrupt-driven comm port stuff}

{Also provides a terminal view - if this is created and then passed as
a parameter to the serial port, the serial port will inform it of
characters coming through}

unit comport;

INTERFACE

uses views, tui,
			doscom, {interrupt com port server}
			dattime, {timer}
			objects, {pstring}
			files, {load/store}
			devices;

const
	{for justwait}
	ForWrite = False;
	ForRead = True;

type
	{the terminal view supplied by textview is far too slow to keep up with
	the unbuffered serial port, and as it is simply used as a viewer to keep track
	of what's going on, we'll bin it and use a simple terminal instead:}
	{DO NOT CHANGE SIZE WHILE RUNNING!}

	PTerminal = ^TTerminal;
	TTerminal = object(TView)
		Lines : array[0..20] of PString; {don't make box bigger than 20 lines}
		constructor init(const X,Y,L,D : integer);
		destructor Done; virtual;
		procedure Draw; virtual;
		procedure AddChar(const C : char);
		procedure AddStr(const S : String);
	end;

{============== SERIAL COM PORT OBJECT ==========================}
type
	PSerialDevice = ^TSerialDevice;
	TSerialDevice = object(TDeviceStream)

		Port : PortType;
		BaudRate : BaudType;
		ChTimeOut : byte; {time to wait in 100ths of seconds for next char before timing out}
		WFTimeOut : byte; {time to wait in 100ths of seconds for next *data block* (eg modem response) before timeout}
		Timer : TTimer; {for use when reading blocks, waiting to see if any more}

		Terminal : PTerminal;

		{--- device admin ----}
		constructor Init(NName : String; const NPort : byte; const NBaudRate : word);

		constructor Load(var S : TDataStream);
		procedure Store(var S : TDataStream);

		{-- device methods ---}
		procedure Open; virtual;
		procedure Close; virtual;

		procedure UpdateStatus; virtual;
		function StatusText : string; virtual; {works out text message from returned AH register}

		function ReadCh : char; virtual;
		function ReadLn : string; virtual;

		{-- timeout waiting ---}
		procedure WaitFor(const ForRead : boolean; const S100 : byte);

		procedure Flush; virtual;
		procedure ChWait(const ForRead : boolean);
		function 	WaitToStop : string;

		procedure DeviceWrite(const S : String); virtual;

		{-- comm port methods ---}
		function PortStatus : word;
		function CharReady : boolean;  {is a character ready?}
		function ComReady : boolean; 		{is it clear to send?}
	end;


	PComStatusWindow = ^TComStatusWindow;
	TComStatusWindow = object(TWindow)
		Terminal : PTerminal;
		{at some point could add Tx/Rx markers, IsOpen, etc}
		constructor Init(const X,Y,L,D : integer; ATitle : TTitleStr);
	end;

IMPLEMENTATION

uses
{$IFDEF WINDOWS}
	wui,	{windows}
{$ELSE}
	app,	tuimsgs, {text}
{$ENDIF}
	tuiedit,
	help,
	minilib;

{**********************************************************
 ***                                                    ***
 ***                   SERIAL PORT DEVICE               ***
 ***                                                    ***
 **********************************************************}

{=== INITIALISING ==========================================}

constructor TSerialDevice.Init;
var	R : TRect;
begin
	inherited Init(NName, '');

	case NPort of
		1 : Port := COM1;
		2 : Port := COM2;
	else
		ProgramError(NName+' Init'#13'Only ports 1 & 2 allowed',hcEditSerial);
		fail;
	end;

	case NBaudRate of
		110  	: BaudRate := B110;
		150  	: BaudRate := B150;
		300  	: BaudRate := B300;
		600  	: BaudRate := B600;
		1200 	: BaudRate := B1200;
		2400 	: BaudRate := B2400;
		4800 	: BaudRate := B4800;
		9600	: BaudRate := B9600;
		19200 : BaudRate := B19200;
		38400 : BaudRate := B38400;
		57600 : BaudRate := B57600;
{		115200 : BaudRate := B115200;{out of case range}
	else
		ProgramError(NName+' Init'#13'Baud Rate '+N2Str(NBaudRate)+' invalid',hcEditSerial);
		fail;
	end;

	ChTimeOut := 10000 div NBaudRate ;
	if ChTimeOut<5 then ChTimeOut:= 5;{needed?}
	WFTimeOut := 50; {half a second}

	Status := stOk;

	Terminal := nil;
end;

constructor TSerialDevice.Load;
var Ver : byte;
begin
	S.Read(Ver, 1);
	case Ver of
		1 : begin
			inherited Load(S);
			S.Read(Port,1);
			S.Read(BaudRate, 1);
			S.Read(ChTimeOut, 1);
			S.Read(WFTimeOut, 1);
		end;
	end;

	Terminal :=nil;
end;

procedure TSerialDevice.Store;
var Ver : byte;
begin
	Ver := 1; S.Write(Ver, 1);
	inherited Store(S);
	S.Write(Port,1);
	S.Write(BaudRate, 1);
	S.Write(ChTimeOut, 1);
	S.Write(WFTimeOut, 1);
end;

{****************************************
 ***  MSDOS Links                     ***
 ****************************************}
{--- OPEN CHANNEL -----------------------}
procedure TSerialDevice.Open;
begin
	{assumes no parity, 1 stop bit and 8 bit word length, no flow control}
	InitCom(Port, BaudRate, None, D8, S1, No);

	CheckStatus('Opening');

	IsOpen := True;
end;

{--- CLOSE CHANNEL -----------------------}
procedure TSerialDevice.Close;
begin
	Flush;
	IsOpen := False;
	IsInitialised := False;

	ExitCom(port);
end;

{==== PORT STATUS =================================================}
{Returns low byte as modem status byte, high byte as serial port status byte}
function TSerialDEvice.PortStatus : word;
begin
	PortStatus := 0;
end;

procedure TSerialDevice.UpdateStatus;
begin
	Status := stOK;

	ErrorInfo := PortStatus;
end;


{=== CHECK FOR READY =========================}
function TSerialDevice.CharReady : boolean;
begin
	CharReady := ComReceived(Port);
end;

function TSerialDevice.ComReady : boolean;
begin
	ComReady := ComAllowed(Port);
end;

{=== ERROR TEXT MESSAGE ======================}
function TSerialDevice.StatusText : string;
var S : string;
		AH : byte;
begin
	StatusText := inherited StatusText;

{	AH := (ErrorInfo and $FF) div $100;

	S := hex(AH)+': ';
	if (AH and $01)>0 then S := S + 'Data Ready, ';
	if (AH and $02)>0 then S := S + 'Overrun Error, ';
	if (AH and $04)>0 then S := S + 'Parity Error, ';
	if (AH and $08)>0 then S := S + 'Framing Error, ';
	if (AH and $10)>0 then S := S + 'Break Detected, ';
	if (AH and $20)>0 then S := S + 'THR empty, ';
	if (AH and $40)>0 then S := S + 'TSR empty, ';
	if (AH and $80)>0 then S := S + 'Timeout, ';

	StatusText := copy(S,1,length(S)-2); {remove last space}
end;


{=== READ =========================================}
function TSerialDevice.ReadCh;
var Ch : char;
begin
	if CharReady then begin
		Ch := ReadCom(port);
		if Terminal<>nil then Terminal^.AddChar(Ch);
		ReadCh := Ch;
	end else
		ReadCh := #0;
end;

function TSerialDevice.ReadLn;
var S : string;

begin
	S:='';

	if CharReady then
		repeat
			if CharReady then begin
				S := S + ReadCh;
				if not CharReady then ChWait(ForRead);
			end else begin
				Status := stReadError;
				ErrorInfo := 199; {timeout}
			end;
		until (S[ord(S[0])]=#10) or (Status<>stOK);

	if S<>'' then begin
		while (S[length(S)]=#10) or (S[length(S)]=#13) do dec(S[0]);
		if (Terminal<>nil) then	Terminal^.DrawView;
	end;

	ReadLn := S;
end;

{========= WAIT TO STOP ==================}
{Waits for serial port to *stop* sending, returning last line set
 Useful for modems.  Waits for 1 second after last charready}
function TSerialDevice.WaitToStop;
var S : string;
		StopTimer : TTimer;

begin
	S:='';
	StopTimer.Start;

	repeat
		if CharReady then begin
			S := Readln;
			StopTimer.Start;
		end;
	until StopTimer.S100>WFTimeOut;

	WaitToStop := S;
	Reset; {in case last line wasn't complete, ie had no CRLF on end}
end;

procedure TSerialDevice.Flush;
begin
	WaitToStop;
{	repeat
		ReadCh;
		if not CharReady then ChWait(ForRead);
	until not CharReady;{}
end;

{don't know what to call this - waits for up to chDelay 100th secs, or
 a char is ready to read/write}
procedure TSerialDevice.ChWait(const ForRead : boolean);
begin
	Timer.Start;
	repeat until	 (CharReady and ForRead) 			{character arrived}
							or (ComReady  and not ForRead) {com out allowed}
							or (Timer.S100>ChTimeOut);
end;

{General one for above}
procedure TSerialDevice.WaitFor(const ForRead : boolean; const S100 : byte);
begin
	Timer.Start;
	repeat until	 (CharReady and ForRead) 			{character arrived}
							or (ComReady  and not ForRead) {com out allowed}
							or (Timer.S100>S100);
end;


{=== WRITE =============================================}
procedure TSerialDevice.DeviceWrite(const S : String);
var I : byte;
begin
	for I := 1 to length(S) do
		if Status=stOK then begin

			if not ComReady then ChWait(ForWrite);
			if not ComReady then begin
				Status := stWriteError;
				ErrorInfo := 199; {timeout}
			end else
				WriteCom(Port, S[I]);

		end;

{	if (Status=stOK) and (Terminal<>nil) then begin
		Terminal^.AddStr(S);
		Terminal^.DrawView;
	end;{}
end;

{**********************************************************
 ***                                                    ***
 ***                   STATUS VIEWS                     ***
 ***                                                    ***
 **********************************************************}

{*****************************
 ***      STATUS WINDOW    ***
 *****************************}
constructor TComStatusWindow.Init;
var	R : TRect;
begin
	R.XYLD(X,Y,L,D);
	inherited init(R, ATitle, 0);

	New(Terminal, init(1,1,Size.X-2,Size.Y-2));
	Insert(Terminal);
end;

{*****************************
 ***      TERMINAL         ***
 *****************************}
constructor TTerminal.Init;
var I : byte;
		R : TRect;
begin
	R.XYLD(X,Y,L,D);
	inherited init(R);
	for I := 0 to Size.Y do begin
		GetMem(Lines[I], Size.X+1); {+1 byte for length}
		FillChar(Lines[I]^[1], Size.X, #0); {blank out line}
		Lines[I]^[0] := char(lo(Size.X));
	end;
	Cursor.X :=0;
	Cursor.Y :=0;
end;

destructor TTerminal.Done;
var L : byte;
begin
	for L := 0 to Size.Y do
		FreeMem(Lines[L], Size.X);

	inherited Done;
end;

procedure TTerminal.Draw;
var I : byte;
begin
	for I := 0 to Size.Y do WriteStr(0,I,Lines[I]^,1);
end;

procedure TTerminal.AddChar;
var I : byte;
		P : PString;
begin
	case C of
		#10 : if Cursor.Y=Size.Y-1 then begin
			{line feed, scroll up}
			P := Lines[0]; {preserve first pointer}
			for I := 0 to Size.Y-2 do Lines[I] := Lines[I+1]; {switch pointer}
			Lines[Size.Y-1] := P; {set last line to point to first...}
			FillChar(Lines[Size.Y-1]^[1], Size.X, #0); {.. and clear it}
		end else
			inc(Cursor.Y);

		#13 : Cursor.X := 0;

	else
		if Cursor.X>=Size.X then begin AddChar(#10); AddChar(#13); end;
		Lines[Cursor.Y]^[Cursor.X+1] := C;
		inc(Cursor.X);
	end;
	DrawView; {WriteStr(1,CUrsor.Y,Lines[Cursor.Y]^,1);{}
end;

procedure TTerminal.AddStr;
var C : byte;
begin
	for C := 1 to length(S) do AddChar(S[C]); {for the moment}
end;

end.
