Power-Programmierung/CD1.mdf/pascal/library/dos/multtsk/cpm25d/glasstty.inc

Text File | 1994-04-28 | 10.9 KB | 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;