home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / Libraries / PNL Libraries / MyTimeManager.p < prev    next >
Encoding:
Text File  |  1995-10-23  |  2.1 KB  |  106 lines  |  [TEXT/CWIE]
  1. unit MyTimeManager;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Timer,MyCallProc;
  7.  
  8.     type
  9.         XTMTask = record
  10.                 tm: TMTask;
  11.                 completion: UniversalProcPtr;
  12.             end;
  13.         XTMTaskPtr = ^XTMTask;
  14.  
  15.     procedure StartupTimeManager;
  16. { WARNING: xtm must be locked in memory from XInsertTime to XRemoveTime }
  17.     procedure XInsertTime (xtm: XTMTaskPtr);
  18.     procedure XRemoveTime (xtm: XTMTaskPtr);
  19.     procedure XPrimeTime (xtm: XTMTaskPtr; completion: UniversalProcPtr; count: longInt);
  20. { procedure completion(xtm: XTMTaskPtr); }
  21.  
  22.     const
  23.         uppXTimerProcInfo = uppPascal04ProcInfo;
  24.  
  25.     function NewXTimerProc(userRoutine: ProcPtr): UniversalProcPtr;
  26. {$IFC not GENERATINGPOWERPC }
  27.     inline
  28.         $2E9F;
  29. {$ENDC}
  30.  
  31. implementation
  32.  
  33.     uses
  34.         QLowLevel, PreserveA5, MyStartup;
  35.  
  36.     var
  37.         gTimeMangerProc : TimerUPP;
  38.     
  39. {$IFC GENERATINGPOWERPC}
  40.  
  41.     procedure TimeManger(xtmp: XTMTaskPtr);
  42.     begin
  43.         if xtmp^.completion <> nil then begin
  44.             CallPascal04(xtmp, xtmp^.completion);
  45.         end;
  46.     end;
  47.  
  48. {$ELSEC}
  49.  
  50.     procedure TimeManger;
  51.         var
  52.             xtmp: XTMTaskPtr;
  53.             olda5: Ptr;
  54.     begin
  55.         xtmp := XTMTaskPtr(GetRegA1);
  56.         olda5 := SetPreservedA5;
  57.         if xtmp^.completion <> nil then begin
  58.             CallPascal04(xtmp, xtmp^.completion);
  59.         end;
  60.         RestoreA5(olda5);
  61.     end;
  62.  
  63. {$ENDC}
  64.  
  65. {$IFC GENERATINGPOWERPC }
  66.     function NewXTimerProc(userRoutine: ProcPtr): UniversalProcPtr;
  67.     begin
  68.         NewXTimerProc:=NewRoutineDescriptor(userRoutine,uppXTimerProcInfo,GetCurrentISA);
  69.     end;
  70. {$ENDC}
  71.     
  72.     procedure XInsertTime (xtm: XTMTaskPtr);
  73.     begin
  74.         xtm^.tm.tmCount := 0;
  75.         xtm^.tm.tmAddr := gTimeMangerProc;
  76.         xtm^.tm.tmWakeUp := 0;
  77.         xtm^.tm.tmReserved := 0;
  78.         xtm^.completion := nil;
  79.         InsXTime(QElemPtr(xtm));
  80.     end;
  81.  
  82.     procedure XRemoveTime (xtm: XTMTaskPtr);
  83.     begin
  84.         RmvTime(QElemPtr(xtm));
  85.     end;
  86.  
  87.     procedure XPrimeTime (xtm: XTMTaskPtr; completion: ProcPtr; count: longInt);
  88.     begin
  89.         xtm^.completion := completion;
  90.         PrimeTime(QElemPtr(xtm), count);
  91.     end;
  92.  
  93.     function XInitTimeManager(var msg: integer): OSStatus;
  94.     begin
  95.         msg := msg; { Unused }
  96.         gTimeMangerProc := NewTimerProc(@TimeManger);
  97.         XInitTimeManager := noErr;
  98.     end;
  99.     
  100.     procedure StartupTimeManager;
  101.     begin
  102.         StartuppreserveA5;
  103.         SetStartup(XInitTimeManager, nil, 0, nil);
  104.     end;
  105.     
  106. end.