home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / multtsk / cpm25d / calldos.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-28  |  4.4 KB  |  170 lines
  1. {$I cpmswitc.inc}
  2. {$M 5000,0,10000}
  3.  
  4. {--------------------------------------------------------------------------
  5.  
  6. CALLDOS.PAS  (Demonstrating capabilities of the unit MTPopup.)
  7.  
  8. This program requires the CPMULTI Multitasking Toolkit and Turbo Pascal
  9. 5.0 or later.
  10.  
  11. January 1994
  12.  
  13. Copyright (C) 1994 (USA)        Copyright (C) 1989-1994
  14. Hypermetrics                    Christian Philipps Software-Technik
  15. PO Box 9700 Suite 363           Duesseldorfer Str. 316
  16. Austin, TX  78758-9700          D-47447 Moers
  17.                                 Germany
  18.  
  19.   This program executes COMMAND.COM as a task, giving a DOS shell
  20.   to the user. Pressing F10 will show the task status window.
  21.  
  22. ---------------------------------------------------------------------------}
  23.  
  24. program MTPopupDemo;
  25.  
  26. uses DOS, CRT, CPMulti, MTPopup;
  27.  
  28. var  StatusSem : Pointer;
  29.  
  30. {-----------------------------------------------------------------------------}
  31.  
  32. {$F+}
  33. procedure Trigger(P:Pointer);
  34.  
  35. { Wait for a keystyroke and turn the status display on or off. }
  36.  
  37. var PopupHandle : Byte;
  38.  
  39. begin
  40.   PopupHandle := RegisterPopup($00004400);
  41.   if PopupHandle = 0 then
  42.   begin
  43.     Writeln('Error in PopupRegister!');
  44.     Halt;
  45.   end;
  46.   repeat
  47.     if NOT PopupWait(PopupHandle) then
  48.     begin
  49.       Writeln('Error in PopupWait!');
  50.       Halt;
  51.     end;
  52.     if SemGetSignals(StatusSem) > 0 then 
  53.       SemWait(StatusSem)
  54.     else
  55.       SemSignal(StatusSem);
  56.   until False;
  57. end;  {Trigger}
  58. {$F-}
  59.  
  60. {-----------------------------------------------------------------------------}
  61.  
  62. procedure Frame (X1,Y1,X2,Y2:Byte);
  63.  
  64. var N : Byte;
  65.  
  66. begin
  67.   GotoXY(X1,Y1);
  68.   Write('╔');
  69.   for N := 1 TO X2-X1-1 do
  70.     Write('═');
  71.   Write('╗');
  72.   for N := 1 TO Y2-Y1-1 do
  73.   begin
  74.     GotoXY(X1,Y1+N);
  75.     Write('║');
  76.     GotoXY(X2,Y1+N);
  77.     Write('║');
  78.   end;
  79.     GotoXY(X1,Y2);
  80.   Write('╚');
  81.   for N := 1 TO X2-X1-1 do
  82.     Write('═');
  83.   Write('╝');
  84. end;  { Frame }
  85.  
  86. {-----------------------------------------------------------------------------}
  87.  
  88. {$F+}
  89. procedure StatusTask(P:Pointer);
  90.  
  91. { Update the status window every second. }
  92.  
  93. var X, Y : Byte;
  94.  
  95. begin
  96.   repeat
  97.     SemWait(StatusSem);
  98.     X := WhereX;
  99.     Y := WhereY;
  100.     Frame(1,17,79,25);
  101.     Window(2,18,78,24);
  102.     ClrScr;
  103.     Writeln;
  104.     Writeln('Idle Loop    ->');
  105.     Writeln('DOS Task     ->');
  106.     Writeln('MTPopup Task ->');
  107.     Writeln('Status Task  ->');
  108.     Writeln('Hotkey Task  ->');
  109.     Window(18,18,78,24);
  110.     DumpTaskTable;
  111.     Write('Turn off by pressing F10 again.');
  112.     Window(1,1,80,25);
  113.     SemSignal(StatusSem);
  114.     GotoXY(X,Y);
  115.     Sleep(Seconds(1));
  116.   until False;
  117. end;  {StatusTask}
  118. {$F-}
  119.  
  120. {-----------------------------------------------------------------------------}
  121.  
  122. procedure Copyright;
  123.  
  124. begin
  125.   ClrScr;
  126.   Writeln('               Multitasking Popup Unit Version 2.5');
  127.   Writeln('        (c) Copyright Christian Philipps Software-Technik');
  128.   Writeln('                    ──────────────────────────');
  129.   Writeln;
  130. end;
  131.  
  132. {-----------------------------------------------------------------------------}
  133.  
  134. begin
  135.   if CreateSem(StatusSem) <> Sem_OK then
  136.   begin
  137.     Writeln('Error in CreateSem!');
  138.     Halt;
  139.   end;
  140.   SemClear(StatusSem);
  141.   if CreateTask(StatusTask,NIL,Pri_Kernel,300) < 0 then
  142.   begin
  143.     Writeln('Error in creation of Status task!');
  144.     Halt;
  145.   end;
  146.   if CreateTask(Trigger,NIL,Pri_Kernel,100) < 0 then
  147.   begin
  148.     Writeln('Error in creation of Trigger task!');
  149.     Halt;
  150.   end;
  151.   Copyright;
  152.   Writeln('This program demonstrates several of the capabilities of the Multitasking');
  153.   Writeln('Toolkit''s MTPopup unit:');
  154.   Writeln('  a) Execution of a DOS application (here COMMAND.COM) as a task');
  155.   Writeln('  b) Activation of a task by hotkey');
  156.   Writeln('  c) Parallel execution of a DOS task with the other tasks. The others');
  157.   Writeln('     can suspend the DOS task when necessary; this is an alternative');
  158.   Writeln('     to writing TSR''s.');
  159.   Writeln;
  160.   Writeln('You can now display a task status window in the lower third of the screen');
  161.   Writeln('by pressing the F10 hotkey. The contents of this window are updated every');
  162.   Writeln('second; the previous contents of the screen are lost in this demo.');
  163.   Writeln('Pressing F10 again turns off the status function.');
  164.   Writeln('The demo program is terminated by typing EXIT at the DOS prompt.');
  165.   EnablePopups;
  166.   CallDos(GetEnv('comspec'),'');
  167.   DisablePopups;
  168.   Copyright;
  169. end.
  170.