home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
pascal
/
library
/
dos
/
multtsk
/
cpm25d
/
speedup.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-04-28
|
2KB
|
99 lines
{$I cpmswitc.inc}
{--------------------------------------------------------------------------
SPEEDUP.PAS (Demo: Speedup test)
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 illustrates the use of the Speedup function in
the CPMulti kernel.
---------------------------------------------------------------------------}
program SpeedUpTest1;
uses CRT, CPMulti;
const NoTsk = 5;
var SoundSem : Pointer; { Coordination of Sound() access. }
TaskNo : Word;
c : Char;
Speed : Word;
{---------------------------------------------------------------------------}
{$F+}
procedure BeepTask(P:Pointer);
var MyNo : Word;
begin
MyNo := Word(P);
Writeln('Task # ',MyNo,' is now active!');
repeat { Task body }
SemWait(SoundSem); { Request the sound generator. }
Sound(MyNo * 300);
Delay(1);
NoSound;
SemSignal(SoundSem); { Release the sound generator. }
Sleep(1);
until False;
end;
{$F-}
{---------------------------------------------------------------------------}
begin {Main}
ClrScr;
Speed := 1;
{ Create the semaphores. }
if (CreateSem(SoundSem) <> Sem_OK) then
begin
Writeln('Error in creating a semaphore!');
Halt(1);
end;
{ Create the Beep task. }
for TaskNo := 1 to NoTsk do
begin
if CreateTask(BeepTask,Pointer(TaskNo),Pri_User,500) < 0 then
begin
Writeln(^G'Error in creating task ',TaskNo);
Halt(1);
end;
end;
{ Actual work begins here. }
Writeln('Alter the Speedup factor with +/-; ESC to exit');
repeat
repeat
Sleep(1)
until Keypressed;
C := ReadKey;
SemWait(SoundSem);
case C of
'+': Inc(Speed);
'-': if Speed > 0 then
Dec(Speed);
end;
Writeln('Speed=',Speed);
SpeedUp(Speed);
SemSignal(SoundSem);
until C = #27;
SemWait(SoundSem); { Prevent further sound. }
Window(1,1,80,25);
GotoXY(1,23);
end.