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