home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / multtsk / cpm25d / glasstty.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-28  |  4KB  |  152 lines
  1. {$I cpmswitc.inc}
  2.  
  3. {--------------------------------------------------------------------------
  4.  
  5. GLASSTTY.PAS  (Simple terminal program demonstrating CommPipe unit)
  6.  
  7. This program requires the CPMULTI Multitasking Toolkit and Turbo Pascal
  8. 5.0 or later.
  9.  
  10. January 1994
  11.  
  12. Copyright (C) 1994 (USA)        Copyright (C) 1989-1994
  13. Hypermetrics                    Christian Philipps Software-Technik
  14. PO Box 9700 Suite 363           Duesseldorfer Str. 316
  15. Austin, TX  78758-9700          D-47447 Moers
  16.                                 Germany
  17.  
  18. This is a bare-bones terminal emulator which illustrates the
  19. capabilities of the CommPipe unit.
  20.  
  21. ---------------------------------------------------------------------------}
  22.  
  23. program GlassTTY;
  24.  
  25. uses CRT, DOS, CPMulti, Comm, CommPipe;
  26.  
  27. const Finished    : Boolean = False;
  28.       Echo        : Boolean = False;
  29.  
  30. var   C           : Char;
  31.       Regs        : Registers;
  32.       LastSelect  : Byte;
  33.  
  34. {$I GLASSTTY.INC}
  35.  
  36. {--------------------------------------------------------------------------}
  37.  
  38. {$F+}
  39. procedure CommInput(P:Pointer);
  40. var C : Char;
  41. begin
  42.   Read(AuxIn,C);
  43.   while not Finished and (IoResult = 0) do
  44.   begin
  45.     Write(C);
  46.     Read(AuxIn,C);
  47.   end;
  48. end;
  49. {$F-}
  50.  
  51. {--------------------------------------------------------------------------}
  52.  
  53. procedure GoodMorning;
  54. begin
  55.   TextColor(7);
  56.   TextBackground(0);
  57.   ClrScr;
  58.   Writeln('GlassTTY V1.00 / C. Philipps / Sept. 1989');
  59.   Writeln('----------------------------------------');
  60.   Writeln;
  61.   Writeln('Alt-X: Exit the program');
  62.   Writeln('Alt-E: Toggle echo mode');
  63.   Writeln;
  64.   Writeln('GlassTTY online...');
  65.   Writeln;
  66. end;
  67.  
  68. {--------------------------------------------------------------------------}
  69.  
  70. procedure GoodNight;
  71. begin
  72.   TextColor(7);
  73.   TextBackground(0);
  74.   ClrScr;
  75.   Writeln('Have a nice day...');
  76. end;
  77.  
  78. {--------------------------------------------------------------------------}
  79.  
  80. procedure Output(C:Char);
  81.  
  82. { Output characters (onto the screen if Echo is on) and over
  83.   the comm port. }
  84.  
  85. begin
  86.   if Echo then 
  87.     Write(C);
  88.   Write(AuxOut,C);
  89.   if IoResult <> 0 then 
  90.   begin
  91.     Writeln('Error in writing to AuxOut!');
  92.     Halt(1);
  93.   end;
  94. end;
  95.  
  96. {--------------------------------------------------------------------------}
  97.  
  98. procedure GoOnline;
  99. var CommInTask : TaskNoType;
  100. begin
  101.   OpenAux(Ports[Selects[1].Current],
  102.           BaudRate[Selects[2].Current],
  103.           Parity[Selects[3].Current],
  104.           DataBits[Selects[4].Current],
  105.           StopBits[Selects[5].Current],
  106.           2048);
  107.   CommInTask := CreateTask(CommInput,NIL,Pri_User+1,500);
  108.   if CommInTask < 0 then 
  109.   begin
  110.     Writeln('Error from CreateTask!');
  111.     Halt(1);
  112.   end;
  113.   GoodMorning;
  114.   repeat
  115.     C := DoReadKey;
  116.     if SpecialChar then 
  117.       case C of
  118.         #45:  Finished := True;
  119.         #18:  begin
  120.                 Echo := not Echo;
  121.                 Write('Echo is ');
  122.                 if Echo then 
  123.                   Writeln('on')
  124.                 else 
  125.                   Writeln('off');
  126.               end;
  127.       else
  128.         Output(C);
  129.       end
  130.     else Output(C);
  131.   until Finished;
  132.   CloseAux(CommInTask);
  133. end;
  134.  
  135. {--------------------------------------------------------------------------}
  136.  
  137. begin
  138.   SpeedUp(3);
  139.   TimeSlice(1,10);
  140.   InitSelection;
  141.   Selection := 1;
  142.   repeat
  143.     Finished := False;
  144.     LastSelect := Selection;
  145.     SetupScreen;
  146.     C := DoSelect(LastSelect);
  147.     if C = F1 then 
  148.       GoOnline;
  149.   until C = #27;
  150.   GoodNight;
  151. end.
  152.