home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / multtsk / cpmult / demo / speedup.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-04-07  |  1.9 KB  |  86 lines
  1. PROGRAM SpeedUpTest1;
  2.  
  3. {$R-,S-,I-,D-,F-,V-,B-,N-,L-}
  4. {
  5.  
  6.   Christian Philipps Software-Technik
  7.   Düsseldorfer Str. 316
  8.   4130 Moers 1
  9.  
  10.   Januar 1989
  11. }
  12.  
  13. USES Crt, CpMulti;
  14.  
  15. CONST NoTsk  = 5;
  16.  
  17. VAR   SoundSem : Pointer;   { Koordination des Sound()-Zugriffs }
  18.       TaskNo   : Word;
  19.       c        : Char;
  20.       Speed    : Word;
  21.  
  22. {---------------------------------------------------------------------------}
  23.  
  24. {$F+}
  25. PROCEDURE PiepsTask(P:Pointer);
  26.  
  27. VAR  MyNo : Word;
  28.  
  29. BEGIN {PiepsTask}
  30.   MyNo := Word(P);
  31.   Writeln('Task Nr. ',MyNo,' ist jetzt aktiv!');
  32.   REPEAT                 { Taskrumpf }
  33.     SemWait(SoundSem);   { Anfordern des Sound-Generators }
  34.     Sound(MyNo * 300);
  35.     Delay(1);
  36.     NoSound;
  37.     SemSignal(SoundSem); { Freigeben des Sound-Generators }
  38.     Sleep(1);
  39.   UNTIL False;
  40. END;  {PiepsTask}
  41. {$F-}
  42.  
  43. {---------------------------------------------------------------------------}
  44.  
  45. BEGIN {Main}
  46.   ClrScr;
  47.   Speed := 1;
  48.  
  49.   { Erzeugen der Semaphoren }
  50.   IF (CreateSem(SoundSem) <> Sem_Ok)
  51.      THEN BEGIN
  52.             Writeln('Fehler beim Erzeugen einer Semaphore!');
  53.             Halt(1);
  54.           END;
  55.  
  56.   { Erzeugen der Pieps-Tasks }
  57.   FOR TaskNo := 1 TO NoTsk DO
  58.   BEGIN
  59.     IF CreateTask(PiepsTask,Pointer(TaskNo),Pri_User,500) < 0
  60.        THEN BEGIN
  61.               Writeln(^G'Fehler beim Erzeugen der Task ',TaskNo);
  62.               Halt(1);
  63.             END;
  64.   END;
  65.  
  66.   { Hauptprogramm - Verarbeitung }
  67.   Writeln('Veränderung des Speedup-Faktors mit +/-; Ende mit ESC');
  68.   REPEAT
  69.     REPEAT Sleep(1); UNTIL Keypressed;
  70.     C := ReadKey;
  71.     SemWait(SoundSem);
  72.     CASE C OF
  73.      '+': Inc(Speed);
  74.      '-': IF Speed > 0
  75.              THEN Dec(Speed);
  76.     END;
  77.     Writeln('Speed=',Speed);
  78.     SpeedUp(Speed);
  79.     SemSignal(SoundSem);
  80.   UNTIL C = #27;
  81.  
  82.   SemWait(SoundSem);    { Verhindere weitere Tonerzeugung }
  83.   Window(1,1,80,25);
  84.   GotoXY(1,23);
  85. END.
  86.