home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
library
/
dos
/
multtsk
/
cpm25d
/
glasstty.inc
< prev
next >
Wrap
Text File
|
1994-04-28
|
11KB
|
454 lines
{--------------------------------------------------------------------------
GLASSTTY.INC (GlassTTY include file; see GLASSTTY.PAS)
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
---------------------------------------------------------------------------}
const MaxValues = 9; { Maximum number of possible selectable values. }
MaxFields = 5; { Maximum number of fields. }
MaxCommLen = 20; { Maximum length of a field identifier. }
MaxFieldLen = 30; { Maximum length of data. }
Up = #72;
Down = #80;
Tab = #9;
CR = #13;
Esc = #27;
BTab = #15;
F1 = #59;
F2 = #60;
ExitChars : set of Char = [Esc,F1,F2];
{ Characters which terminate the selection routines. }
Ports : array[1..2] of ComType
= (Com1,Com2);
BaudRate : array[1..9] of BaudType
= (b110,b150,b300,b600,b1200,b2400,b4800,b9600,b19200);
Parity : array[1..5] of ParityType
= (Space,Odd,Mark,Even,None);
DataBits : array[1..4] of DataBitsType
= (d5,d6,d7,d8);
StopBits : array[1..2] of StopBitsType
= (s1,s2);
type CommentType = string[MaxCommLen];
ValueType = string[MaxFieldLen];
Str80 = string[80];
FieldType = record
Row : Byte; { Screen row. }
Column : Byte; { Start of field identifier. }
Comment : CommentType; { Field identifier. }
BarLen : Byte; { Length of the color bar. }
Value : Byte; { Count of selectable values. }
{ or BufLen input fields. }
Current : Byte; { Index of actual value. }
Inp : Boolean; { Marker for input fields. }
Data : array[1..MaxValues] of ValueType;
end;
var Selection : Byte; { Number of actual choices. }
Selects : array[1..MaxFields] of FieldType;
SpecialChar : Boolean; { Marker for DoReadKey. }
{--------------------------------------------------------------------------}
function DoReadKey:Char;
{ Keyboard input without blocking multitasking. }
var C : Char;
begin
repeat Sleep(1); until KeyPressed;
C := ReadKey;
if C = #0 then
begin
C := ReadKey;
SpecialChar := True;
end
else
SpecialChar := False;
DoReadKey := C;
end;
{-----------------------------------------------------------------------------}
function IsColor : Boolean;
{ This function returns True, if a color graphics adapter is installed;
a register structure Regs is needed. }
begin
with Regs do
begin
AH := 15;
Intr($10,Regs);
IsColor := (AL <> 7);
end;
end;
{-----------------------------------------------------------------------------}
procedure CursorOff;
{ Turns the cursor off; needs the function IsColor. }
begin
with Regs do
begin
if IsColor then
begin
CH := 9;
CL := 10;
end
else
begin
CH := 31;
CL := 32;
end;
AH := 1;
end;
Intr($10,Regs);
end;
{-----------------------------------------------------------------------------}
procedure CursorOn;
{ Restores a normal cursor; needs the function IsColor. }
begin
with Regs do
begin
if IsColor then
begin
CH := 6;
CL := 7;
end
else
begin
CH := 11;
CL := 12;
end;
AH := 1;
end;
Intr($10,Regs);
end;
{-----------------------------------------------------------------------------}
procedure ReverseVideo;
{ Enables reverse video. }
begin
TextColor(0);
TextBackground(7);
end;
{-----------------------------------------------------------------------------}
procedure DrawBar(SelectNo : Byte);
{ Generates a color bar according to field SelectNo. }
begin
with Selects[SelectNo] do
begin
GotoXY(Column,Row);
ReverseVideo;
Write(Copy(Comment,1,BarLen));
LowVideo;
end;
end;
{-----------------------------------------------------------------------------}
procedure HighVideo;
begin
TextColor(15);
TextBackground(0);
end;
{-----------------------------------------------------------------------------}
procedure LowVideo;
begin
TextColor(7);
TextBackground(0);
end;
{-----------------------------------------------------------------------------}
procedure RemoveBar(SelectNo : Byte);
{ Removes the color bar again. }
begin
with Selects[SelectNo] do
begin
GotoXY(Column,Row);
LowVideo;
Write(Copy(Comment,1,BarLen));
end;
end;
{-----------------------------------------------------------------------------}
procedure PrintSelection(SelectNo : Byte);
{ Output the actual values for the field SelectNo. }
begin
with Selects[SelectNo] do
begin
GotoXY(Column+Byte(Comment[0]),Row);
HighVideo;
Write(Data[Current]);
LowVideo;
end;
end;
{-----------------------------------------------------------------------------}
function Replicate(C:Char;Count:Byte):Str80;
{ Needs a type declaration Str80:string[80]. }
var N : Byte;
Z : Str80;
begin
Z[0] := Chr(Count);
FillChar(Z[1],Count,C);
Replicate := Z;
end;
{-----------------------------------------------------------------------------}
procedure PadValueArea(SelectNo:Byte; C:Char);
{ Fill the data area for the input field SelectNo. }
begin
with Selects[SelectNo] do
begin
GotoXY(Column+Byte(Comment[0]),Row);
Write(Replicate(C,Value));
end;
end;
{-----------------------------------------------------------------------------}
procedure DoInput(SelectNo : Byte);
var AuxField : ValueType;
begin
with Selects[SelectNo] do
begin
HighVideo;
PadValueArea(SelectNo,'.');
Current := 1; { Make sure. }
GotoXY(Column+Byte(Comment[0]),Row);
CursorOn;
Read(AuxField);
CursorOff;
if Byte(AuxField[0]) > 0 then
Data [1] := AuxField;
PadValueArea(SelectNo,' ');
LowVideo;
PrintSelection(SelectNo);
end;
end;
{-----------------------------------------------------------------------------}
procedure InitSelection;
{ Initialize the field parameters. }
begin
with Selects[1] do
begin
Row := 6;
Column := 10;
Comment := 'Com-Port........: ';
BarLen := 17;
Value := 2;
Current := 1;
Inp := False;
Data [1] := 'Com1:';
Data [2] := 'Com2:';
end;
with Selects[2] do
begin
Row := 7;
Column := 10;
Comment := 'Transfer rate...: ';
BarLen := 17;
Value := 9;
Current := 8;
Inp := False;
Data [1] := '110 ';
Data [2] := '150 ';
Data [3] := '300 ';
Data [4] := '600 ';
Data [5] := '1200 ';
Data [6] := '2400 ';
Data [7] := '4800 ';
Data [8] := '9600 ';
Data [9] := '19200';
end;
with Selects[3] do
begin
Row := 8;
Column := 10;
Comment := 'Parity..........: ';
BarLen := 17;
Value := 5;
Current := 5;
Inp := False;
Data [1] := 'Space';
Data [2] := 'Odd ';
Data [3] := 'Mark ';
Data [4] := 'Even ';
Data [5] := 'None ';
end;
with Selects[4] do
begin
Row := 9;
Column := 10;
Comment := 'Data bits.......: ';
BarLen := 17;
Value := 4;
Current := 4;
Inp := False;
Data [1] := '5';
Data [2] := '6';
Data [3] := '7';
Data [4] := '8';
end;
with Selects[5] do
begin
Row := 10;
Column := 10;
Comment := 'Stop bits.......: ';
BarLen := 17;
Value := 2;
Current := 1;
Inp := False;
Data [1] := '1';
Data [2] := '2';
end;
end;
{-----------------------------------------------------------------------------}
procedure SetupScreen;
{ Build the screen mask. }
begin
ClrScr;
GotoXY(15,1);
Writeln('GlassTTY V1.00 (c) C. Philipps, March 1989');
GotoXY(15,2);
Writeln('============================================');
for Selection := 1 to MaxFields do
begin
RemoveBar(Selection);
PrintSelection(Selection);
end;
GotoXY(12,21);
Writeln('Select input fields by using tab and backtab;');
GotoXY(12,22);
Writeln('Choose from the possible parameters by using the cursor keys.');
GotoXY(20,24);
HighVideo;
Writeln('F1 = Terminal mode / Esc = Exit');
end;
{-----------------------------------------------------------------------------}
function DoSelect(Start:Byte) : Char;
{ Begins with the selection mask of the field Start and returns the end-key
(CR or Esc). }
var C : Char;
begin
if Start in [1..MaxFields] then
Selection := Start
else
Selection := 1;
CursorOff;
DrawBar(Selection);
repeat
C := DoReadKey;
if SpecialChar then
case C of
BTab: begin
RemoveBar(Selection);
Selection := Pred(Selection);
if Selection < 1 then
Selection := MaxFields;
DrawBar(Selection);
end;
Up: with Selects[Selection] do
if Inp then
DoInput(selection)
else
with Selects[Selection] do
begin
Current := Pred(Current);
if not (Current in [1..Value]) then
Current := Value;
if Value > 1 then
PrintSelection(Selection);
end;
Down: with Selects[Selection] do
if Inp then
DoInput(selection)
else
with Selects[Selection] do
begin
Current := Succ(Current);
if not (Current in [1..Value]) then
Current := 1;
if Value > 1 then
PrintSelection(Selection);
end;
end
else
case C of
Tab: begin
RemoveBar(Selection);
Selection := Succ(Selection);
if Selection > MaxFields then
Selection := 1;
DrawBar(Selection);
end;
end;
until C in ExitChars;
CursorOn;
DoSelect := C;
end;