home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / multtsk / cpmult / demo / glasstty.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-04-07  |  3.2 KB  |  148 lines

  1. {$I-,R-,S-,D-,F-,V-,B-,N-,L-}
  2.  
  3. PROGRAM GlassTty;
  4.  
  5. { Einfaches Terminalprogramm zur Demonstration der Anwendung
  6.   von V24Pipe.
  7.  
  8.   Autor: Christian Philipps Software-Technik
  9.          Düsseldorfer Str. 316
  10.  
  11.          4130 Moers 1
  12.  
  13.   Stand: Sep. 1989
  14. }
  15.  
  16. USES Crt, Dos, CpMulti, V24, V24Pipe;
  17.  
  18. CONST Ende        : Boolean = False;
  19.       Echo        : Boolean = False;
  20.  
  21. VAR   C           : Char;
  22.       Regs        : Registers;
  23.       LastSelect  : BYTE;
  24.  
  25. {$I GLASSTTY.INC}
  26.  
  27. {--------------------------------------------------------------------------}
  28.  
  29. {$F+}
  30. PROCEDURE V24Input(P:Pointer);
  31.  
  32. VAR  C : Char;
  33.  
  34. BEGIN
  35.   Read(AuxIn,C);
  36.   WHILE Not Ende AND (IoResult = 0) DO
  37.   BEGIN
  38.     Write(C);
  39.     Read(AuxIn,C);
  40.   END;
  41. END;
  42. {$F-}
  43.  
  44. {--------------------------------------------------------------------------}
  45.  
  46. PROCEDURE GoodMorning;
  47.  
  48. BEGIN {GoodMorning}
  49.   TextColor(7);
  50.   TextBackground(0);
  51.   ClrScr;
  52.   Writeln('GlassTty V1.00 / C. Philipps / Sep. 1989');
  53.   Writeln('----------------------------------------');
  54.   Writeln;
  55.   Writeln('Alt-X: Ende des Programmes');
  56.   Writeln('Alt-E: Toggle Echo Modus');
  57.   Writeln;
  58.   Writeln('Glasstty online...');
  59.   Writeln;
  60. END;  {GoodMorning}
  61.  
  62. {--------------------------------------------------------------------------}
  63.  
  64. PROCEDURE GoodNight;
  65.  
  66. BEGIN {GoodNight}
  67.   TextColor(7);
  68.   TextBackground(0);
  69.   ClrScr;
  70.   Writeln('Have a nice day...');
  71. END;  {GoodNight}
  72.  
  73. {--------------------------------------------------------------------------}
  74.  
  75. PROCEDURE Output(C:Char);
  76.  
  77. { Ausgabe eines Zeichens auf dem Bildschirm, falls Echo on und über
  78.   die Schnittstelle }
  79.  
  80. BEGIN {Output}
  81.   IF Echo
  82.      THEN Write(C);
  83.   Write(AuxOut,C);
  84.   IF IoResult <> 0
  85.      THEN BEGIN
  86.             Writeln('Fehler beim Schreiben von AuxOut!');
  87.             Halt(1);
  88.           END;
  89. END;  {Output}
  90.  
  91. {--------------------------------------------------------------------------}
  92.  
  93. PROCEDURE GoOnline;
  94.  
  95. VAR  V24InTask : TaskNoType;
  96.  
  97. BEGIN {GoOnline}
  98.   OpenAux(Ports[Selects[1].Current],
  99.           Baudraten[Selects[2].Current],
  100.           Paritaet[Selects[3].Current],
  101.           Datenbits[Selects[4].Current],
  102.           Stopbits[Selects[5].Current],
  103.           2048);
  104.   V24InTask := CreateTask(V24Input,NIL,Pri_User+1,500);
  105.   IF V24InTask < 0
  106.      THEN BEGIN
  107.             Writeln('Fehler bei CreateTask!');
  108.             Halt(1);
  109.           END;
  110.   GoodMorning;
  111.   REPEAT
  112.     C := DoReadKey;
  113.     IF SpecialChar
  114.        THEN CASE C OF
  115.               #45:  Ende := True;
  116.               #18:  BEGIN
  117.                       Echo := Not Echo;
  118.                       Write('Echo ist ');
  119.                       IF Echo
  120.                          THEN Writeln('an')
  121.                          ELSE Writeln('aus');
  122.                     END;
  123.               ELSE
  124.                 Output(C);
  125.             END
  126.        ELSE Output(C);
  127.   UNTIL Ende;
  128.   CloseAux(V24InTask);
  129. END;  {GoOnline}
  130.  
  131. {--------------------------------------------------------------------------}
  132.  
  133. BEGIN {Main}
  134.   SpeedUp(3);
  135.   TimeSlice(1,10);
  136.   InitSelection;
  137.   Selection := 1;
  138.   REPEAT
  139.     Ende := False;
  140.     LastSelect := Selection;
  141.     SetupScreen;
  142.     C := DoSelect(LastSelect);
  143.     IF C = F1
  144.        THEN GoOnline;
  145.   UNTIL C = #27;
  146.   GoodNight;
  147. END.  {Main}
  148.