home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / multtsk / cpm25d / beeper.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-28  |  3.5 KB  |  134 lines
  1. {$I cpmswitc.inc}
  2.  
  3. {---------------------------------------------------------------------------
  4.  
  5. BEEPER.PAS
  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 demonstrates some of the most basic features of 
  19.   the CPMulti kernel, including semaphores, code sharing, and
  20.   priority changing.
  21.  
  22. ---------------------------------------------------------------------------}
  23.  
  24. program Beeper;
  25.  
  26. uses CRT, CPMulti;
  27.     
  28. const NoTsk  = 5;
  29.       
  30. var   Sem      : Pointer;   { Coordination of the start phase }
  31.       SoundSem : Pointer;   { Coordination of Sound() access }
  32.       TaskNo   : Word;
  33.       C        : Char;
  34.  
  35. {---------------------------------------------------------------------------}
  36.  
  37. {$F+}            
  38. procedure BeepTask(P:Pointer);
  39.  
  40. { This task was defined in the code-sharing demo. It emits a beeping sound
  41.   every three seconds. }
  42.  
  43. var  MyNo : Word;
  44. begin
  45.   MyNo := TaskNo;        { Get number from global variable. }
  46.   Writeln('Task # ',MyNo,' is now active!');
  47.   SemSignal(Sem);        { Let the main program continue. }
  48.   repeat                 { Task body. }
  49.     Sleep(Seconds(3));
  50.     SemWait(SoundSem);   { Request the sound generator. }
  51.     Sound(MyNo * 300);
  52.     Delay(50);
  53.     NoSound;
  54.     SemSignal(SoundSem); { Release the sound generator. }
  55.   until False;
  56. end;
  57.  
  58. {---------------------------------------------------------------------------}
  59.  
  60. procedure BuzzTask(P:Pointer);
  61.  
  62. { This task buzzes for half a second, once every six seconds. }
  63.  
  64. begin
  65.   repeat
  66.     Sleep(Seconds(6));
  67.     SemWait(SoundSem);
  68.     Sound(300);
  69.     Delay(500);
  70.     NoSound;
  71.     SemSignal(SoundSem);
  72.   until False;
  73. end;
  74. {$F-}
  75.  
  76. {---------------------------------------------------------------------------}
  77.  
  78. begin {Main}
  79.   ClrScr;
  80.   Writeln('This program creates five tasks, each emitting a beep every');
  81.   Writeln('three seconds (of varying pitch. It also creates a task which');
  82.   Writeln('buzzes for a half-second, once every six seconds.');
  83.   Writeln('The sound tasks have higher priority than the main program!');
  84.   Writeln;
  85.   Writeln('The main program spends its time waiting for input,');
  86.   Writeln('until the application is terminated by the pressing of ESC.');
  87.   Writeln;
  88.  
  89.   { Create the semaphores. }
  90.   if (CreateSem(Sem) <> Sem_OK) or (CreateSem(SoundSem) <> Sem_OK) then 
  91.   begin
  92.     Writeln('Error in the creation of a semaphore!');
  93.     Halt(1);
  94.   end;
  95.  
  96.   { Create the beep tasks. }
  97.   for TaskNo := 1 to NoTsk do
  98.   begin
  99.     SemClear(Sem);
  100.     if CreateTask(BeepTask,nil,Pri_Kernel,300) < 0 then 
  101.     begin
  102.       Writeln(^G'Error in creating task ',TaskNo);
  103.       Halt(1);
  104.     end;
  105.     SemWait(Sem);
  106.   end;
  107.  
  108.   { Create the buzz task. }
  109.   if CreateTask(BuzzTask,nil,Pri_Kernel,300) < 0 then 
  110.   begin
  111.     Writeln(^G'Error in creating the buzz task!');
  112.     Halt(1);
  113.   end;
  114.  
  115.   GotoXY(20,15);
  116.   Writeln('---------------------------------------');
  117.   Window(1,16,80,25);
  118.  
  119.   { The actual work begins here. }
  120.   repeat
  121.     if KeyPressed then 
  122.     begin
  123.       C := ReadKey;
  124.       Write(c);
  125.       if C=#13 then 
  126.         Writeln;
  127.     end;
  128.   until C=#27;
  129.  
  130.   SemWait(SoundSem);    { Prevent further sound. }
  131.   Window(1,1,80,25);
  132.   GotoXY(1,23);
  133. end.
  134.