home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / multtsk / cpm25d / speedup.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-28  |  2.4 KB  |  99 lines
  1. {$I cpmswitc.inc}
  2.  
  3. {--------------------------------------------------------------------------
  4.  
  5. SPEEDUP.PAS  (Demo: Speedup test)
  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 program illustrates the use of the Speedup function in
  19. the CPMulti kernel.
  20.  
  21. ---------------------------------------------------------------------------}
  22.  
  23. program SpeedUpTest1;
  24.  
  25. uses CRT, CPMulti;
  26.      
  27. const NoTsk  = 5;
  28.       
  29. var   SoundSem : Pointer;   { Coordination of Sound() access. }
  30.       TaskNo   : Word;
  31.       c        : Char;
  32.       Speed    : Word;
  33.  
  34. {---------------------------------------------------------------------------}
  35.  
  36. {$F+} 
  37. procedure BeepTask(P:Pointer);
  38. var  MyNo : Word;
  39. begin
  40.   MyNo := Word(P);
  41.   Writeln('Task # ',MyNo,' is now active!');
  42.   repeat                 { Task body }
  43.     SemWait(SoundSem);   { Request the sound generator. }
  44.     Sound(MyNo * 300);
  45.     Delay(1);
  46.     NoSound;
  47.     SemSignal(SoundSem); { Release the sound generator. }
  48.     Sleep(1);              
  49.   until False;
  50. end;
  51. {$F-}
  52.  
  53. {---------------------------------------------------------------------------}
  54.               
  55. begin {Main}
  56.   ClrScr;
  57.   Speed := 1;
  58.  
  59.   { Create the semaphores. }
  60.   if (CreateSem(SoundSem) <> Sem_OK) then 
  61.   begin
  62.     Writeln('Error in creating a semaphore!');
  63.     Halt(1);
  64.   end;
  65.  
  66.   { Create the Beep task. }
  67.   for TaskNo := 1 to NoTsk do
  68.   begin
  69.     if CreateTask(BeepTask,Pointer(TaskNo),Pri_User,500) < 0 then 
  70.     begin
  71.       Writeln(^G'Error in creating task ',TaskNo);
  72.       Halt(1);
  73.     end;
  74.   end;
  75.  
  76.   { Actual work begins here. }
  77.  
  78.   Writeln('Alter the Speedup factor with +/-; ESC to exit');
  79.   repeat
  80.     repeat 
  81.       Sleep(1)
  82.     until Keypressed;
  83.     C := ReadKey;
  84.     SemWait(SoundSem);     
  85.     case C of
  86.       '+': Inc(Speed);
  87.       '-': if Speed > 0 then 
  88.              Dec(Speed);
  89.     end;
  90.     Writeln('Speed=',Speed);
  91.     SpeedUp(Speed);
  92.     SemSignal(SoundSem);
  93.   until C = #27;
  94.  
  95.   SemWait(SoundSem);    { Prevent further sound. }
  96.   Window(1,1,80,25);
  97.   GotoXY(1,23);
  98. end.
  99.