home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
library
/
dos
/
multtsk
/
cpm25d
/
beeper.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-04-28
|
4KB
|
134 lines
{$I cpmswitc.inc}
{---------------------------------------------------------------------------
BEEPER.PAS
This program requires the CPMULTI Multitasking Toolkit and Turbo Pascal
5.0 or later.
January 1994
Copyright (C) 1994 (USA) Copyright (C) 1989-1994
Hypermetrics Christian Philipps Software-Technik
PO Box 9700 Suite 363 Duesseldorfer Str. 316
Austin, TX 78758-9700 D-47447 Moers
Germany
This program demonstrates some of the most basic features of
the CPMulti kernel, including semaphores, code sharing, and
priority changing.
---------------------------------------------------------------------------}
program Beeper;
uses CRT, CPMulti;
const NoTsk = 5;
var Sem : Pointer; { Coordination of the start phase }
SoundSem : Pointer; { Coordination of Sound() access }
TaskNo : Word;
C : Char;
{---------------------------------------------------------------------------}
{$F+}
procedure BeepTask(P:Pointer);
{ This task was defined in the code-sharing demo. It emits a beeping sound
every three seconds. }
var MyNo : Word;
begin
MyNo := TaskNo; { Get number from global variable. }
Writeln('Task # ',MyNo,' is now active!');
SemSignal(Sem); { Let the main program continue. }
repeat { Task body. }
Sleep(Seconds(3));
SemWait(SoundSem); { Request the sound generator. }
Sound(MyNo * 300);
Delay(50);
NoSound;
SemSignal(SoundSem); { Release the sound generator. }
until False;
end;
{---------------------------------------------------------------------------}
procedure BuzzTask(P:Pointer);
{ This task buzzes for half a second, once every six seconds. }
begin
repeat
Sleep(Seconds(6));
SemWait(SoundSem);
Sound(300);
Delay(500);
NoSound;
SemSignal(SoundSem);
until False;
end;
{$F-}
{---------------------------------------------------------------------------}
begin {Main}
ClrScr;
Writeln('This program creates five tasks, each emitting a beep every');
Writeln('three seconds (of varying pitch. It also creates a task which');
Writeln('buzzes for a half-second, once every six seconds.');
Writeln('The sound tasks have higher priority than the main program!');
Writeln;
Writeln('The main program spends its time waiting for input,');
Writeln('until the application is terminated by the pressing of ESC.');
Writeln;
{ Create the semaphores. }
if (CreateSem(Sem) <> Sem_OK) or (CreateSem(SoundSem) <> Sem_OK) then
begin
Writeln('Error in the creation of a semaphore!');
Halt(1);
end;
{ Create the beep tasks. }
for TaskNo := 1 to NoTsk do
begin
SemClear(Sem);
if CreateTask(BeepTask,nil,Pri_Kernel,300) < 0 then
begin
Writeln(^G'Error in creating task ',TaskNo);
Halt(1);
end;
SemWait(Sem);
end;
{ Create the buzz task. }
if CreateTask(BuzzTask,nil,Pri_Kernel,300) < 0 then
begin
Writeln(^G'Error in creating the buzz task!');
Halt(1);
end;
GotoXY(20,15);
Writeln('---------------------------------------');
Window(1,16,80,25);
{ The actual work begins here. }
repeat
if KeyPressed then
begin
C := ReadKey;
Write(c);
if C=#13 then
Writeln;
end;
until C=#27;
SemWait(SoundSem); { Prevent further sound. }
Window(1,1,80,25);
GotoXY(1,23);
end.