Category : Pascal Source Code
Archive   : CMP25D.ZIP
Filename : GLASSTTY.PAS

{$I cpmswitc.inc}

{--------------------------------------------------------------------------

GLASSTTY.PAS (Simple terminal program demonstrating CommPipe unit)

This program requires the CPMULTI Multitasking Toolkit and Turbo Pascal
5.0 or later.

January 1994

Copyright (C) 1994 (USA) Copyright (C) 1989-1994
Hypermetrics Christian Philipps Software-Technik
PO Box 9700 Suite 363 Duesseldorfer Str. 316
Austin, TX 78758-9700 D-47447 Moers
Germany

This is a bare-bones terminal emulator which illustrates the
capabilities of the CommPipe unit.

---------------------------------------------------------------------------}

program GlassTTY;

uses CRT, DOS, CPMulti, Comm, CommPipe;

const Finished : Boolean = False;
Echo : Boolean = False;

var C : Char;
Regs : Registers;
LastSelect : Byte;

{$I GLASSTTY.INC}

{--------------------------------------------------------------------------}

{$F+}
procedure CommInput(P:Pointer);
var C : Char;
begin
Read(AuxIn,C);
while not Finished and (IoResult = 0) do
begin
Write(C);
Read(AuxIn,C);
end;
end;
{$F-}

{--------------------------------------------------------------------------}

procedure GoodMorning;
begin
TextColor(7);
TextBackground(0);
ClrScr;
Writeln('GlassTTY V1.00 / C. Philipps / Sept. 1989');
Writeln('----------------------------------------');
Writeln;
Writeln('Alt-X: Exit the program');
Writeln('Alt-E: Toggle echo mode');
Writeln;
Writeln('GlassTTY online...');
Writeln;
end;

{--------------------------------------------------------------------------}

procedure GoodNight;
begin
TextColor(7);
TextBackground(0);
ClrScr;
Writeln('Have a nice day...');
end;

{--------------------------------------------------------------------------}

procedure Output(C:Char);

{ Output characters (onto the screen if Echo is on) and over
the comm port. }

begin
if Echo then
Write(C);
Write(AuxOut,C);
if IoResult <> 0 then
begin
Writeln('Error in writing to AuxOut!');
Halt(1);
end;
end;

{--------------------------------------------------------------------------}

procedure GoOnline;
var CommInTask : TaskNoType;
begin
OpenAux(Ports[Selects[1].Current],
BaudRate[Selects[2].Current],
Parity[Selects[3].Current],
DataBits[Selects[4].Current],
StopBits[Selects[5].Current],
2048);
CommInTask := CreateTask(CommInput,NIL,Pri_User+1,500);
if CommInTask < 0 then
begin
Writeln('Error from CreateTask!');
Halt(1);
end;
GoodMorning;
repeat
C := DoReadKey;
if SpecialChar then
case C of
#45: Finished := True;
#18: begin
Echo := not Echo;
Write('Echo is ');
if Echo then
Writeln('on')
else
Writeln('off');
end;
else
Output(C);
end
else Output(C);
until Finished;
CloseAux(CommInTask);
end;

{--------------------------------------------------------------------------}

begin
SpeedUp(3);
TimeSlice(1,10);
InitSelection;
Selection := 1;
repeat
Finished := False;
LastSelect := Selection;
SetupScreen;
C := DoSelect(LastSelect);
if C = F1 then
GoOnline;
until C = #27;
GoodNight;
end.