home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / MTASK211 / MTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1991-03-30  |  3KB  |  95 lines
  1. program MTest;   { Tests the features in MTask                                }
  2.  
  3. uses
  4.   Crt,           { Standard Turbo Pascal CRT unit                             }
  5.   MTask;         { Appropriate MTask .TPU unit                                }
  6.  
  7. const
  8.   CR = #13;      { Define the carriage return character                       }
  9.   LF = #10;      { Define the line feed character                             }
  10.  
  11. var
  12.   foobar : string[2];   { Dummy string used in vaious funcs/procs             }
  13.  
  14.  
  15. { Enhance CRT's delay() procedure by adding timeslicing, and status update    }
  16. procedure Pause( Secs : word );
  17. var
  18.   Loop : word;
  19. begin
  20.   for Loop := 1 to (Secs * 1000) do
  21.     begin
  22.       str( (Loop div 1000), foobar );
  23.       write( foobar, CR );
  24.       TaskSwitch;
  25.       delay(1)
  26.     end
  27. end;   { Pause }
  28.  
  29. { Enhance the usual "repeat until keypressed" loop by adding timeslicing      }
  30. procedure Get;
  31. begin
  32.   repeat
  33.     TaskSwitch
  34.   until KeyPressed;
  35.   foobar[1] := readkey
  36. end;   { Get }
  37.  
  38.  
  39. { main }
  40. begin
  41.   DirectVideo := false;
  42.   writeln( 'MTest 2.01', LF );
  43.  
  44.   write( 'Multitasker detected: ' );
  45.   case DetectMultitasker of
  46.      0 : writeln( 'none' );
  47.      1 : writeln( 'TopView or compatible (TaskView, OmniView, etc.)' );
  48.      2 : writeln( 'TAME (2.10/2.20/2.30) controlled programme' );
  49.      3 : writeln( 'DESQview' );
  50.      4 : writeln( 'MultiDOS II' );
  51.      5 : writeln( 'MultiDOS III' );
  52.      6 : writeln( 'DoubleDOS' );
  53.      7 : writeln( 'Windows 2.xx (or lower?)' );
  54.      8 : writeln( 'Windows 3.xx (or higher?)' );
  55.      9 : writeln( 'OS/2''s DOS Compatibility Box' );
  56.     10 : writeln( 'ConcurrentDOS' );
  57.     11 : writeln( 'PC-MOS/386' );
  58.     12 : writeln( 'MultiLink' );
  59.   else
  60.     writeln( '**internal error**' );
  61.   end;
  62.  
  63.   write( LF, LF, 'Run timer tests? [Y/N] ... ' );
  64.   Get;
  65.   if upcase(foobar[1]) = 'Y' then
  66.     begin
  67.       writeln( CR, LF, LF, 'This task will now pause for 10 seconds.  It should NOT take' );
  68.       writeln( 'up valuable CPU time, as it continually executes task switches' );
  69.       writeln( 'without loosing it''s own pause time...', LF );
  70.       writeln( 'Press any key to begin!' );
  71.       Get;
  72.       writeln( '     GO...' );
  73.       Pause(10);
  74.       writeln( '     STOP.' );
  75.       writeln( LF, LF, 'This task will now pause for 5 seconds.  It should NOT take' );
  76.       writeln( 'up valuable CPU time, as it continually executes task switches' );
  77.       writeln( 'without loosing it''s own pause time...', LF );
  78.       writeln( 'Press any key to begin!' );
  79.       Get;
  80.       writeln( '     GO...' );
  81.       Pause(5);
  82.       writeln( '     STOP.' );
  83.       writeln( LF, LF, 'This task will now pause for 20 seconds.  It should NOT take' );
  84.       writeln( 'up valuable CPU time, as it continually executes task switches' );
  85.       writeln( 'without loosing it''s own pause time...', LF );
  86.       writeln( 'Press any key to begin!' );
  87.       Get;
  88.       writeln( '     GO...' );
  89.       Pause(20);
  90.       writeln( '     STOP.' )
  91.     end;
  92.   writeln( CR, LF, 'MTest - done.' )
  93. end.   { MTest }
  94.  
  95.