Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/OASSASM.ZIP/SAMPLE7.PAS

Pascal/Delphi Source File | 1988-03-27 | 5.6 KB | 184 lines

PROGRAM dc_monitor;  {a simple datacom line monitor}

uses scl;    {make SCL accessible}

VAR
  Ok      : BOOLEAN;
  Wrkstr  : String80;
  Temp    : INTEGER;
  Freeze  : BOOLEAN;

FUNCTION Xlate(Cn:INTEGER):String10;  {datacom control character}
VAR Tmp:String10;                     {interpretation}
BEGIN;
  CASE Cn OF
     $0 : Tmp:='<NUL>';
     $1 : Tmp:='<SOH>';
     $2 : Tmp:='<STX>';
     $3 : Tmp:='<ETX>';
     $4 : Tmp:='<EOT>';
     $5 : Tmp:='<ENQ>';
     $6 : Tmp:='<ACK>';
     $7 : Tmp:='<BEL>';
     $8 : Tmp:='<BS>';
     $9 : Tmp:='<HT>';
     $a : Tmp:='<LF>';
     $b : Tmp:='<VT>';
     $c : Tmp:='<FF>';
     $d : Tmp:='<CR>';
     $e : Tmp:='<S0>';
     $f : Tmp:='<S1>';
     $10: Tmp:='<DLE>';
     $11: Tmp:='<DC1>';
     $12: Tmp:='<DC2>';
     $13: Tmp:='<DC3>';
     $14: Tmp:='<DC4>';
     $15: Tmp:='<NAK>';
     $16: Tmp:='<SYN>';
     $17: Tmp:='<ETB>';
     $18: Tmp:='<CAN>';
     $19: Tmp:='<EM>';
     $1a: Tmp:='<SUB>';
     $1b: Tmp:='<ESC>';
     $1c: Tmp:='<FS>';
     $1d: Tmp:='<GS>';
     $1e: Tmp:='<RS>';
     $1f: Tmp:='<US>';
     $70: Tmp:='<POL>';
     $71: Tmp:='<SEL>';
     $72: Tmp:='<FSL>';
     $73: Tmp:='<BSL>';
     $7f: Tmp:='<DEL>';
     $80..$ff:
          Tmp:='<' + St(Cn) + '>';    {return character code}
  ELSE
          Tmp:=CHR(Cn);               {return character}
  END;
  Xlate:=Tmp;
END;

{$F+} {far call option required for SCL background tasks}
PROCEDURE Lp_Background_Task;      {updates the line traffic field}
BEGIN;
  IF NOT Freeze THEN               {F9 toggles Freeze}
    BEGIN;
      REPEAT
        Receive_Char(Temp,Ok);     {receive char from datacom}
        IF Ok THEN                 {there was one}
          BEGIN;
            Wrkstr:=Wrkstr+Xlate(Temp);  {interpret it}
            WHILE LENGTH(Wrkstr) > 76 DO {cut off oldest}
              DELETE(Wrkstr,1,1);
          END;
      UNTIL NOT Ok;                      {no more characters}
      W_Cont(7,Wrkstr);            {update traffic field}
    END;
END;
{$F-}   {reset far calls again}

PROCEDURE Update_Params;         {spacebar pressed}
VAR Sp:INTEGER;
BEGIN;
  CASE Active_Field OF
    1: BEGIN;                   {linespeed}
         Sp:=Nr(G_Cont(1));     {get current speed}
         IF Sp =  110 THEN Sp:= 150 ELSE
         IF Sp =  150 THEN Sp:= 300 ELSE {switch}
         IF Sp =  300 THEN Sp:= 600 ELSE  {to}
         IF Sp =  600 THEN Sp:=1200 ELSE  {next}
         IF Sp = 1200 THEN Sp:=2400 ELSE  {speed}
         IF Sp = 2400 THEN Sp:=4800 ELSE
         IF Sp = 4800 THEN Sp:=9600 ELSE
            Sp:=110;
         Dc_Speed:=Sp;                    {update speed}
         W_Cont(1,St(Sp));                {update field}
       END;
    2: BEGIN;                             {char size}
         Sp:=Nr(G_Cont(2));
         Sp:=Sp+1;
         IF Sp > 8 THEN
           Sp:=5;
         Dc_Charsize:=Sp;                 {update param}
         W_Cont(2,St(Sp));                {update field}
       END;
    3: BEGIN;
         Sp:=Nr(G_Cont(3));               {stop bits}
         IF Sp = 1 THEN Sp:=2 ELSE Sp:=1;
         Dc_Stopbits:=Sp;                 {update param}
         W_Cont(3,St(Sp));                {update field}
       END;
    4: IF G_Cont(4) = 'Even'THEN          {parity}
         BEGIN;
           W_Cont(4,'None');
           Dc_Parity:='N';
         END
       ELSE
       IF G_Cont(4) = 'None'THEN
         BEGIN;
           W_Cont(4,'Odd');
           Dc_Parity:='O';
         END
       ELSE
         BEGIN;
           W_Cont(4,'Even');
           Dc_Parity:='E';
         END;
  END;
  Disable_Port;            {temporary disable datacom}
  Set_Dc_Params;           {set new dc params}
  Enable_Port;             {enable datacom again}
END;

PROCEDURE Handle_Uf;
BEGIN;
  IF Char_Code = 32 THEN    {Spacebar pressed}
    BEGIN;
      Update_Params;        {update dc params}
      Char_Code:=Code_Noop; {no further action}
    END
  ELSE
  IF Char_Code = Code_F9 THEN   {F9 Pressed}
    BEGIN;
      Freeze:= NOT Freeze;      {toggle freeze}
      Char_Code:=Code_Noop;     {no further action}
    END
  ELSE
  IF Char_Code = Code_Return   THEN Char_Code:=Code_Tab ELSE
  IF Char_Code = Code_Escape   THEN Char_Code:=Code_Noop;
END;


PROCEDURE Handle_First;   {This Procedure handles format 'first'.}
BEGIN;
  Select_Format('main');
  W_Cont(1,St(Dc_Speed));        {prefill}
  W_Cont(2,St(Dc_Charsize));     {the}
  W_Cont(3,St(Dc_Stopbits));     {fields}
  IF Dc_Parity = 'E' THEN W_Cont(4,'Even') ELSE
  IF Dc_Parity = 'O' THEN W_Cont(4,'Odd') ELSE
     W_Cont(4,'None');
  Freeze:=FALSE;          {display incoming traffic}
  Display_Format(0,0);
  REPEAT
    Handle_Format;        {Complete Loop to handle format input}
    IF User_Function THEN {user key pressed}
      Handle_Uf;          {user interrupt procedure}
  UNTIL Format_Done;      {Either completely filled in or abort pressed}
END;

VAR Res:INTEGER;

BEGIN; {of main}
  Wrkstr:='';
  Select_Format_File('Sample7');   {initializes SCL and loads the format
                                   {file 'Sample7'}
  LP_Background_pointer:=@LP_Background_task;  {invoke our screen updating
                                    routine as low priority background task}
  Auto_Help_Set:=FALSE;             {reset autohelp feature}
  Open_Dc(Res);                    {initialize Datacom system}
  Handle_First;                    {load,display and handle the format}
  Close_Formats;                   {terminate SCL}
  Close_Dc;                        {close Datacom system}
END.  {of main}