home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / CONCUR.ZIP / CPDEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-03-16  |  3.0 KB  |  132 lines
  1. program cpdemo;
  2.  
  3. {Concurrent programming demonstration program}
  4.  
  5.  
  6. {$i biosdec.pas}   {Bios call declarations}
  7. {$i libdec.pas}    {Turbo Library declarations}
  8. {$i concur.pas}    {Concurrent programming module}
  9.  
  10.  
  11. procedure task1;
  12. {Installed as a concurrent program with tasknumber = 1.
  13.  Displays the contents of a text file in its own window}
  14.  
  15. const filename = 'concur.pas';
  16.  
  17. var f : text;
  18.     s : string [37];
  19.     i : integer;
  20.  
  21. begin
  22.   window (1, 1, 40, 20);      {Create task window}
  23.   border ('Contents of file : ' + filename);
  24.   clrscr;
  25.   repeat
  26.     assign (f, filename);
  27.     {$i-} reset (f); {$i+}
  28.     if ioresult <> 0 then writeln ('Cannot find ', filename)
  29.       else
  30.       begin
  31.         while not eof (f) do
  32.           begin
  33.             readln (f, s);
  34.             writeln (s);
  35.             switchtask;
  36.           end;
  37.         close (f);
  38.       end;
  39.     claiminput;
  40.     write ('Hit ENTER to continue ');
  41.     readln (s);
  42.     releaseinput;
  43.   until false;          {Note : task should never return !!!}
  44. end;
  45.  
  46.  
  47. procedure task2;
  48. {Installed as a concurrent program with tasknumber = 2.
  49.  Displays the contents of a text file in its own window}
  50.  
  51. const filename = 'biosdec.pas';
  52.  
  53. var f : text;
  54.     s : string [37];
  55.     i : integer;
  56.  
  57. begin
  58.   window (41, 1, 80, 10);       {Create task window}
  59.   border ('Contents of file : ' + filename);
  60.   clrscr;
  61.   repeat
  62.     assign (f, filename);
  63.     reset (f);
  64.     while not eof (f) do
  65.       begin
  66.         readln (f, s);
  67.         writeln (s);
  68.         switchtask;
  69.       end;
  70.     close (f);
  71.   until false;          {Note : task should never return !!!}
  72. end;
  73.  
  74.  
  75. procedure task3;
  76. {The third concurrent program. Does some simple arithmetic}
  77. var i, j : integer;
  78.  
  79. begin
  80.   window (41, 11, 80, 20);
  81.   border ('Some simple arithmetic');
  82.   clrscr;
  83.   repeat
  84.     for j := 1 to 10 do
  85.       begin
  86.         writeln;
  87.         writeln ('Table of ', j);
  88.         writeln ('-----------');
  89.         for i := 0 to 9 do
  90.           begin
  91.             writeln (i, ' * ', j, ' = ', i*j:2);
  92.             switchtask;
  93.           end;
  94.       end;
  95.     writeln;
  96.     writeln ('Now delaying 2 seconds');
  97.     writeln ('Other tasks will stop!');
  98.     delay (2000);
  99.   until false;
  100. end;
  101.  
  102.  
  103. var ch  : char;
  104.     key : boolean;
  105.  
  106. begin
  107.   taskinit (600);           {Allocate 3*200 paragraph's on stack segment}
  108.   window (1, 21, 80, 25);   {Create window for main program}
  109.   border ('Main program window');
  110.   clrscr;
  111.   writeln ('Hit any key to issue command ');
  112.   write   ('To stop program, enter "H"   ');
  113.   installtask (ofs (task1), 200, 1);  {Install first program}
  114.   installtask (ofs (task2), 200, 2);  {Install second program}
  115.   installtask (ofs (task3), 200, 3);  {Install third program}
  116.  
  117.   repeat
  118.     ch := ' ';
  119.     claiminput;
  120.     key := keypressed;
  121.     if not key then releaseinput;
  122.     if not key then switchtask {Task switching is initiated here}
  123.       else
  124.       begin
  125.         read (kbd, ch);
  126.         write (': ');
  127.         readln (ch);
  128.         releaseinput;
  129.       end;
  130.   until upcase (ch) = 'H';
  131. end.
  132.